粘贴时隐藏隐藏列

Question

我发现并编辑了一个宏，它将多个工作簿中的单元格范围复制到一个工作簿中，汇总表。

我希望隐藏的列在粘贴到DestRange时保持隐藏状态。

例如，如果列B，G，AO，GO隐藏在源文件中，我想将它们隐藏在目标文件中。我的宏复制并粘贴，但取消隐藏所有列。我试过使用xlCellTypeVisible但它不复制隐藏的列。

我也试图把这些行到我的代码：

Dim i As Long 
For i = 1 To 256 
SourceRange.Sheets("Copy Transposed").Columns(i).Hidden = 
DestRange.Sheets("Sheet1").Columns(i).Hidden 
Next i 

这里是我的代码：

Sub MergeSelectedWorkbooks() 
Dim SummarySheet As Worksheet 
Dim FolderPath As String 
Dim SelectedFiles() As Variant 
Dim NRow As Long 
Dim FileName As String 
Dim NFile As Long 
Dim WorkBk As Workbook 
Dim SourceRange As Range 
Dim DestRange As Range 
Dim i As Long 

Set SummarySheet = ThisWorkbook.Worksheets(1) 

FolderPath = "c:\Users\abcdefg\Desktop\input\" 

ChDrive FolderPath 
ChDir FolderPath 

SelectedFiles = Application.GetOpenFilename(_ 
    filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True) 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
NRow = 1 

For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) 
    FileName = SelectedFiles(NFile) 
    Set WorkBk = WorkBooks.Open(FileName) 

    Set SourceRange = WorkBk.Worksheets("Copy Transposed").Range("A2:DP2") 
    Set DestRange = SummarySheet.Range("A" & NRow) 
    Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _ 
     SourceRange.Columns.Count) 

    SourceRange.Copy 
    DestRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
    For i = 1 To 256 
    SourceRange.Sheets("Copy Transposed").Columns(i).Hidden = DestRange.Sheets("Sheet1").Columns(i).Hidden 
    Next i 
    NRow = NRow + DestRange.Rows.Count 
    WorkBk.Close savechanges:=False 
Next NFile 
SummarySheet.Columns.AutoFit 
End Sub 

而且我想唯一可见的工作表从源文件复制。

我把“复制转置”，因为我目前的工作表是这样命名的，但名称将永远是不同的。

我把WorkBk.Worksheets("1")而不是WorkBk.Worksheets("Copy Transposed")，但它只复制第1列。

Answer 1

我已经设法找到我的问题的答案。我加了.PasteSpecial Paste:=8，它工作。我也将工作表的名称改为数字，它也起作用。

这里是我的代码：

Sub macro_final() 
Dim SummarySheet As Worksheet 
Dim FolderPath As String 
Dim SelectedFiles() As Variant 
Dim NRow As Long 
Dim FileName As String 
Dim NFile As Long 
Dim WorkBk As Workbook 
Dim SourceRange As Range 
Dim DestRange As Range 

Set SummarySheet = ThisWorkbook.Worksheets(1) 

FolderPath = "c:\Users\abcdefg\Desktop\input\" 
ChDrive FolderPath 
ChDir FolderPath 

SelectedFiles = Application.GetOpenFilename(_ 
    filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True) 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
NRow = 1 

For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) 
    FileName = SelectedFiles(NFile) 
    Set WorkBk = WorkBooks.Open(FileName) 

    Set SourceRange = WorkBk.Worksheets(1).Range("A2:DZ2") 
    Set DestRange = SummarySheet.Range("A" & NRow) 

    SourceRange.Copy 
    With DestRange 
    .PasteSpecial xlPasteValuesAndNumberFormats 
    .PasteSpecial Paste:=8 
    .PasteSpecial xlPasteFormats 
    End With 

    Application.CutCopyMode = False 

    NRow = NRow + DestRange.rows.Count 
    WorkBk.Close savechanges:=False 

Next NFile 
SummarySheet.rows.AutoFit 
End Sub