首页 > 解决方案 > 将数据从 3 个工作簿复制到 1 个主工作簿

问题描述

我正在努力使用我的代码将数据从具有相同工作表名称的 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

谢谢你的帮助。

标签: excelvba

解决方案


推荐阅读