vba - 循环遍历目录中的 Excel 文件并复制到主表上

Question

我有一个包含近 1000 个 .csv 文件的文件夹。每个文件都包含 2 列，我只想复制其中一列并将其转置到新的工作簿中。新工作簿将包含每个文件中的所有数据。以下代码是我生成的:

    Sub AllFiles()
    Application.EnableCancelKey = xlDisabled

    Dim folderPath As String
    Dim Filename As String
    Dim wb As Workbook

    folderPath = "J:etc. etc. etc." 'contains folder path

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

    Filename = Dir(folderPath & "*.csv")
    Do While Filename <> ""
      Application.ScreenUpdating = False
        Set wb = Workbooks.Open(folderPath & Filename)

        wb.Range(Range("B1"), Range("B1").End(xlDown)).Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveWorkbook.Close True
        Windows("Compiled.xlsm").Activate
        Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True

        Filename = Dir
    Loop
  Application.ScreenUpdating = True
End Sub

无论出于何种原因，代码无法运行，并且会弹出一个框，显示“代码执行已被中断”。一旦我点击“调试”，以下行就会突出显示:

wb.Range(Range("B1"), Range("B1").End(xlDown)).Select

我根本没有使用 VBA 的经验，并且在解决此问题时遇到困难。知道这意味着什么以及我能做什么吗？

Answer 1

突出显示的行指的是正在运行宏的工作簿上的范围，而不是您已打开的工作簿中的范围。尝试用这个替换:

wb.Range(wb.Range("B1"), wb.Range("B1").End(xlDown)).Select

但是，我建议您完全避免使用 Select 函数，因为它会降低代码速度。我对循环进行了一些修剪，以避免使用 Select 和 Activate:

Do While Filename <> ""
  Application.ScreenUpdating = False
    Set wb = Workbooks.Open(folderPath & Filename)
    wb.Range(wb.Cells(1,"B"), wb.Cells(Rows.Count,"B").End(xlUp)).Copy
    Workbooks("Compiled.xlsm").Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    wb.Close True
    Filename = Dir
Loop