[英]Consolidating a specific sheet from different workbooks into one master workbook in a loop
[英]Want to import data from Sheet3 of all workbooks to master workbook?
代码工作正常,但是如果有人指导我从工作表的活动工作表而不是工作表的Sheet3复制数据,请问我将工作表替换为工作表Sheet3,但这也不起作用。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.