2017-08-16 115 views
0

我發現並編輯了一個宏,它將多個工作簿中的單元格範圍複製到一個工作簿中,彙總表。粘貼時隱藏隱藏列

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

+0

做你的所有源表具有相同的隱藏的列?如果沒有,從一張紙上覆制後你隱藏的列將被隱藏,當你從下一張紙複製時,等等...... –

+0

是所有的工作表都有相同的隱藏列,這就是爲什麼我想保持相同的「模板「在Dest Range也是如此 – Adrian

回答

0

我已經設法找到我的問題的答案。我加了.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