繁体   English   中英

是否要将数据从所有工作簿的Sheet3导入到主工作簿?

[英]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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM