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

我对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

Sub-copyDataFromMultipleWorkbooksIntoMaster（）
Dim FolderPath为字符串，Filepath为字符串，Filename为字符串
FolderPath=“C:\Users\25dbrown\Desktop\prototype\”
Filepath=FolderPath&“*.xlsx*”
Filename=Dir（文件路径）
将lastrow变长，lastcolumn变长
文件名“”时执行此操作
工作簿.打开（文件夹路径和文件名）
lastrow=ActiveSheet.Cells（Rows.Count，1）.End（xlUp）.Row
lastcolumn=ActiveSheet.Cells（1，Columns.Count）.End（xlToLeft）.Column
范围（单元格（2，1），单元格（lastrow，lastcolumn））。复制
Application.DisplayAlerts=False
活动工作簿。关闭
erow=Sheet1.单元格（Rows.Count，1）.结束（xlUp）.偏移量（1，0）.行
lastcolumn=ActiveSheet.Cells（1，Columns.Count）.End（xlToLeft）.Column
ActiveSheet.Paste目标：=工作表（“2015”）.范围（单元格（erow，1），单元格（erow，lastcolumn））
Filename=Dir
环
端接头

未测试。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

Sub-copyDataFromMultipleWorkbooksIntoMaster（）
Dim FolderPath为字符串，Filepath为字符串，Filename为字符串
FolderPath=“C:\Users\25dbrown\Desktop\prototype\”
Filepath=FolderPath&“*.xlsx*”
Filename=Dir（文件路径）
漫长的一周
模糊标签一样长
最后一排一样长
将sourcewb设置为工作簿
Dim ws2015作为工作表
周=输入框（“哪一周？”）
设置ws2015=此工作簿。工作表（“2015”）
文件名“”时执行此操作
erow=ws2015.Cells（Rows.Count，1）.End（xlUp）.Row
设置sourcewb=Workbooks.Open（FolderPath和Filename）
lastrow=sourcewb.ActiveSheet.Cells（Rows.Count，1）.End（xlUp）.Row'建议将ActiveSheet更改为工作表（“名称”）
'在指定的一周内循环通过T列
对于i=1到最后一行
如果sourcewb.ActiveSheet.Cells（i，20）.Value=week，则“建议将ActiveSheet更改为工作表（“名称”）
'匹配时，将该行存储到变量以进行复制
tag=i
退出
如果结束
下一个
sourcewb.Worksheets（1）.行（标记）.Copy'建议将工作表更改为工作表（“名称”）
ws2015.细胞（erow，1）.特殊
sourcewb.close
Filename=Dir
环
端接头