粘贴时隐藏隐藏的列答案

【问题标题】：Keep hidden columns hidden when pasting粘贴时隐藏隐藏的列
【发布时间】：2017-10-22 08:22:53
【问题描述】：

我找到并编辑了一个宏，它可以将多个工作簿中的单元格范围复制到一个工作簿中，即摘要表。

我希望隐藏的列在粘贴到 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")，但它只复制了第一列。

【问题讨论】：

所有源工作表是否都有相同的隐藏列？如果没有，您从一张纸复制后隐藏的列将在您从下一张纸复制时取消隐藏，依此类推...
是的，所有工作表都有相同的隐藏列，这就是为什么我也想在 Dest Range 中保留相同的“模板”

标签： vba excel

【解决方案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

【讨论】：