粘贴时隐藏隐藏的列

时间:2017-08-16 14:29:56

标签: vba excel-vba excel

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

我希望隐藏的列在粘贴到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列。

1 个答案:

答案 0 :(得分:0)

我设法找到了问题的答案。我添加了SELECT * FROM ( SELECT *, ROW_NUMBER() OVER(PARTITION BY StudentId ORDER BY StudentMarkId DESC) AS rn FROM [dbo].[StudentMark]) sub WHERE sub.rn = 1; 并且它有效。我还将工作表的名称更改为数字,它也有效。

这是我的代码:

.PasteSpecial Paste:=8
相关问题