Question

代码工作正常但是从活动工作表中复制数据而不是工作簿的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

Answer 1

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

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

1 个答案: