Question

我正在努力将代码从3个工作表名称相同的工作簿中复制数据到一个也具有相同名称的主工作簿中。主要问题是定义最后一行。从第一个工作簿复制第一个数据集然后转到第二个工作簿后，我想将数据粘贴到主工作簿中第一个数据下面，依此类推。你们有什么建议吗？

下面是我未完成的代码：

Sub refresh()
Dim wball, wb1, wb2, wb3 As Workbook
Dim ws, sht As Worksheet
Dim wbpath As String
Dim LastRow As Long

Application.ScreenUpdating = False

wbpath = Application.ThisWorkbook.Path
'wball = ThisWorkbook 'master workbook

Application.DisplayAlerts = False

'clears master wb
Set ws = ThisWorkbook.Worksheets("Tab")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
On Error Resume Next
    ws.Rows(3).ClearContents
    'ws.Rows("3:" & LastRow).Delete
    ws.Range("Tab").Delete

Set wb1 = Workbooks.Open(wbpath & "\file1.xlsm")
LastRow = wb1.Sheets("Tab").Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A3:CD" & LastRow).Value = wb1.Sheets("Tab").Range("A3:CD" & LastRow).Value

Set wb2 = Workbooks.Open(wbpath & "\file2.xlsm")
LastRow = wb2.Sheets("Tab").Cells(ws.Rows.Count, "A").End(xlUp).Row
'ws.
ws.Range("A3:CD" & LastRow).Value = wb2.Sheets("Tab").Range("A3:CD" & LastRow).Value

wb1.Close SaveChanges:=False
wb2.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

好的，我做了一些更改，现在一切都按预期进行。

Sub refresh()
    Dim masterwb As Workbook
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wb3 As Workbook
    Dim masterws As Worksheet
    Dim ws As Worksheet
    Dim wbpath As String
    Dim LastRow As Long
    Dim LastRowSource As Long
    Dim LastRowDestination As Long

    Application.ScreenUpdating = False

    wbpath = Application.ThisWorkbook.Path
    'masterwb = ThisWorkbook

    Application.DisplayAlerts = False

    'clears master wb
    Set masterws = ThisWorkbook.Worksheets("Tab")
    'LastRow = masterws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        masterws.Rows(3).ClearContents
        masterws.Range("A4:CD9999").Delete


'start to copy data from 3 workbooks
    Set wb1 = Workbooks.Open(wbpath & "\file1.xlsm")
    LastRowDestination = wb1.Sheets("Tab").Cells(Rows.Count, "A").End(xlUp).Row
    masterws.Range("A3:CD" & LastRowDestination).Value = wb1.Sheets("Tab").Range("A3:CD" & LastRowDestination).Value

    LastRowSource = masterws.Cells(masterws.Rows.Count, "A").End(xlUp).Row + 1
'LastRowSource + LastRowDestination -3 because im getting 3 extra rows with #N/D
    Set wb2 = Workbooks.Open(wbpath & "\file2.xlsm")
    LastRowDestination = wb2.Sheets("Tab").Cells(Rows.Count, "A").End(xlUp).Row
    masterws.Range("A" & LastRowSource & ":CD" & LastRowSource + LastRowDestination -3).Value = wb2.Sheets("Tab").Range("A3:CD" & LastRowDestination).Value

    LastRowSource = masterws.Cells(masterws.Rows.Count, "A").End(xlUp).Row + 1

    Set wb3 = Workbooks.Open(wbpath & "\file3.xlsm")
    LastRowDestination = wb3.Sheets("Tab").Cells(Rows.Count, "A").End(xlUp).Row
    masterws.Range("A" & LastRowSource & ":CD" & LastRowSource + LastRowDestination -3).Value = wb3.Sheets("Tab").Range("A3:CD" & LastRowDestination).Value


    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False
    wb3.Close SaveChanges:=False
    Application.ScreenUpdating = True
    End Sub

感谢您的帮助。

将数据从3个工作簿复制到1个主数据中

0 个答案: