VBA副本从工作簿到主工作簿 - 错误9更新

Question

我正在尝试将数据从一个工作簿复制到另一个工作簿。但是我会遇到错误9-下标超出范围。

Dim FolderPath As String, Filepath As String, Filename As String
 FolderPath = "F:Test"
 Filepath = FolderPath & "*.xlsm"

 Filename = Dir(Filepath)
 Dim lastrow As Long, lastcolumn As Long
 Do While Filename <> ""
 Workbooks.Open (FolderPath & Filename)
 lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlDown).Row
 lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
 Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
 Application.DisplayAlerts = False
 ActiveWorkbook.Close
 erow = Sheet1111.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

 lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
 Cells(erow, 4))
 ActiveSheet.Paste Destination:=Worksheets("Baza").Range(Cells(erow, 1),         
 Filename = Dir
 Loop
 End Sub

---

使用此代码工作（错误是错误的表名称（它具有名称Sheet1111（Baza））），现在它仅在目录中的最后一个文件中复制数据，我想从所有文件中复制数据。

<</p>

Answer 1

以下代码对我有用：

Option Explicit
Sub Test()
    Application.ScreenUpdating = False ' Reduce screen "flickering"
    Dim FolderPath As String, Filepath As String, Filename As String
    Dim lastrow As Long, lastcolumn As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Set ws = Worksheets("Baza")
    FolderPath = "F:Test"
    Filepath = FolderPath & "*.xlsm"        
    Filename = Dir(Filepath)        
    Do While Filename <> ""
        'Provide status message showing where we are up to
        Application.StatusBar = "Processing " & Filename
        DoEvents
        Set wb = Workbooks.Open(FolderPath & Filename)
        With ActiveSheet ' this isn't strictly necessary, but ensures that we can
                         ' qualify all sheet references to a consistent sheet without
                         ' any surprises
            lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
            .Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy _
                      ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
        Application.DisplayAlerts = False
        wb.Close
        Application.DisplayAlerts = True
        Filename = Dir
    Loop        
    Application.ScreenUpdating = True
    Application.StatusBar = False
End Sub