VBA复制从worbook到主woorkbook – 错误9更新

我正试图将数据从一个工作簿复制到另一个工作簿。 但是我得到错误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）），现在它只复制最后一个文件在目录中的数据，我想从所有文件中复制数据

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