Question

我对VBA很新，经过几个小时的搜索，我找到了一个代码，可以将多个工作簿中的所有数据行复制到主工作簿中。用户工作簿中的数据每天更新。但是，我不希望从用户工作簿中删除数据，因此当我第二次运行宏来捕获新数据时，它会再次复制所有行，因此会复制主工作簿中的数据。工作簿的列T包含数据行的条目的周数。我想使用输入框指定要搜索的周数，然后复制整行。这样我可以每周运行一次宏，但只使用前几周数据而不是整个工作表更新主数据库。这是我目前拥有的宏。请任何人都可以帮忙修改它吗？

    Sub copyDataFromMultipleWorkbooksIntoMaster()

    Dim FolderPath As String, Filepath As String, Filename As String

    FolderPath = "C:\Users\25dbrown\Desktop\Prototypes\"

    Filepath = FolderPath & "*.xlsx*"

    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(2, 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("2015").Rang(Cells(erow,1),  Cells(erow, lastcolumn))                


     Filename = Dir

     Loop

     End Sub

Answer 1

未经测试。 For循环主要是你正在寻找的东西。

Sub copyDataFromMultipleWorkbooksIntoMaster()

Dim FolderPath As String, Filepath As String, Filename As String

FolderPath = "C:\Users\25dbrown\Desktop\Prototypes\"
Filepath = FolderPath & "*.xlsx*"
Filename = Dir(Filepath)

Dim week As Long
Dim tag As Long
Dim lastrow As Long
Dim sourcewb As Workbook
Dim ws2015 As Worksheet

week = InputBox("Which week?")
Set ws2015 = ThisWorkbook.Worksheets("2015")

Do While Filename <> ""

erow = ws2015.Cells(Rows.Count, 1).End(xlUp).Row

Set sourcewb = Workbooks.Open(FolderPath & Filename)
lastrow = sourcewb.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row   'suggest changing activesheet to worksheet("name")

'loop through column T for the specified week
For i = 1 To lastrow
    If sourcewb.ActiveSheet.Cells(i, 20).Value = week Then  'suggest changing activesheet to worksheet("name")
    'upon match store that row to a variable for copying
    tag = i
    Exit For
    End If
Next

sourcewb.Worksheets(1).Rows(tag).Copy   'suggest changing worksheet to worksheet("name")
ws2015.Cells(erow, 1).PasteSpecial

sourcewb.close

Filename = Dir

Loop

End Sub

如何基于变量条件从多个工作簿复制数据行，然后粘贴到主工作簿

1 个答案: