想要将所有工作簿的Sheet3中的数据导入到主工作簿?

代码工作正常,但从活动工作表Sheet3的工作簿好好地复制数据,如果任何人指导我,我用Sheet3replace活动工作表,但也不工作。

Sub copyDataFromMultipleWorkbooksIntoMaster() Dim FolderPath As String, Filepath As String, Filename As String FolderPath = "D:\Copy Multiple Excel to One master\" Filepath = FolderPath & "*.xls*" Filename = Dir(Filepath) Dim LastRow As Long, lastcolumn As Long Do While Filename <> "" Workbooks.Open (FolderPath & Filename) LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column Range(Cells(5, 1), Cells(LastRow, lastcolumn)).Copy Application.DisplayAlerts = False ActiveWorkbook.Close erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 1)) Filename = Dir Loop Application.DisplayAlerts = True End Sub Public Function ModDate() ModDate = Format(FileDateTime(ThisWorkbook.FullName), "m/d/yy h:n ampm") End Function 

 Sub copyDataFromMultipleWorkbooksIntoMaster() Dim FolderPath As String, Filepath As String, Filename As String FolderPath = "D:\Copy Multiple Excel to One master\" Filepath = FolderPath & "*.xls*" Dim lastRow As Long, lastCol As Long, eRow As Long Dim wb As Workbook, ws As Worksheet Application.DisplayAlerts = False Filename = Dir(Filepath) Do While Filename <> "" eRow = Sheet1.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row Set wb = Workbooks.Open(FolderPath & Filename) On Error Goto NextFile Set ws = wb.Worksheets("Sheet3") With ws lastRow = .Cells(.Rows.count, 1).End(xlUp).Row lastCol = .Cells(1, .Columns.count).End(xlToLeft).Column .Range(.Cells(5, 1), .Cells(lastRow, lastCol)).Copy Sheet1.Cells(eRow, 1).PasteSpecial xlPasteValues End With NextFile: On Error Goto 0 wb.Close False Filename = Dir Loop Application.DisplayAlerts = True End Sub