Question

我有一个vba代码，用于复制和粘贴文件夹中多个excel文件的一系列数据。但是，隐藏了包含数据的工作表。我需要修改我的代码来复制隐藏的工作表范围。

Sub Import_to_Master() 
Dim sFolder As String 
Dim sFile As String 
Dim wbD As Workbook, wbS As Workbook

 Application.ScreenUpdating = False Set wbS = ThisWorkbook sFolder =
 wbS.Path & "\"

 sFile = Dir(sFolder) Do While sFile <> ""

 If sFile <> wbS.Name Then Set wbD = Workbooks.Open(sFolder & sFile)
 'open the file; add condition to

 ' >>>>>> Adapt this part wbD.Sheets("data").Range("A3:BD3").Copy
 wbS.Activate Sheets("data scorecards").Range("A" &
 Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Application.CutCopyMode = False ' >>>>>> wbD.Close savechanges:=True
 'close without saving End If

 sFile = Dir 'next file Loop Application.ScreenUpdating = True

End Sub

Answer 1

这看起来很合适。我使用了直接价值转移，而不是复制，粘贴特殊值。

Option Explicit

Sub Import_to_Master()
    Dim sFolder As String, sFile As String
    Dim wbS As Workbook

     Application.ScreenUpdating = False

     Set wbS = ThisWorkbook
     sFolder = wbS.Path & "\"
     sFile = Dir(sFolder & "*.xl*")

     Do While sFile <> ""
        If sFile <> wbS.Name Then
            'open the file; add condition to
            With Workbooks.Open(sFolder & sFile)
                ' >>>>>> Adapt this part wbD
                With .Worksheets("data").Range("A3:BD3")
                    wbS.Worksheets("data scorecards").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count) = .Value
                End With
                'close without saving
                .Close savechanges:=False
             End With
        End If
        sFile = Dir 'next file
     Loop

     Application.ScreenUpdating = True

End Sub

复制隐藏工作表中的范围

1 个答案: