Vba Excel将特定数据单元从多个工作簿复制到主文件

我有不同员工姓名的各种工作手册，其中包含不同的项目编号和在这些项目上工作的时间。我试图将这些项目编号过滤到一个主文件（zmaster），其中包含特定项目编号的整行。我需要Excel在目录（包含所有员工工时文件的特定文件夹）中筛选匹配项，并将这些匹配项复制到zmaster文件中。过滤器是主文件的单元格A1（例如链接图片示例中的300000）。图1是主文件，图2是员工工时文件的示例

(一) (二)

此外，如果Excel能够过滤掉重复的内容（例如，第30周，主文件中的工时和员工姓名完全相同，很可能是重复的，应该忽略）

我是Excel vba的新手，发现/调整了以下宏。第一个复制目录中的所有数据并将其放入主文件。第二个过滤掉与单元格A1匹配的projectnumber。但是，这需要两个步骤，当我第二次运行第一个宏时，它还将收集已输入主文件的数据。此外，我的第二个宏将匹配项放置在与它们放置在员工工时文件中的位置相同的行号中，从而删除放置在同一行的主文件中的早期观察结果（例如，projectnumber 100000位于员工工时文件的第2行，因此复制到主文件的第2行，删除主文件的指标行）

第一个宏：

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String

Filepath = ("C:\test\”)
MyFile = Dir(Filepath)

Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsx" Then
Exit Sub
End If

Workbooks.Open (Filepath & MyFile)
Range("A2:L9").Copy

ActiveWorkbook.Close
erow = Blad1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))

MyFile = Dir
Loop
End Sub

第二个宏：

Sub finddata()
Dim projectnumber As Integer
Dim finalrow As Integer
Dim i As Integer

Sheets("Blad1").Range("A1:H9").ClearContents
projectnumber = Sheets("Blad1").Range("A1").Value
finalrow = Sheets("Blad1").Range("A30").End(x1Up).row

For i = 1 To finalrow
    If Cells(i, 1) = projectnumber Then
        Range(Cells(i, 1), Cells(i, 12)).Copy
        Range("A100").End(x1Up).Offset(1, 0).PasteSpecial x1pasteformulasandnumberformats
        End If
Next i
Range("A1").Select
End sub

希望一切都很清楚，并提前感谢！

这应该行得通

• 打开目录中的每个文件
• 检查文件名是否不是zmaster，是否包含xlsx
• 运行当前文件中的每一行，然后合并复制到主文件的范围
• 复制到主文件的最后一行加上1，这是第一个空行

  Option Explicit
  
  Sub CopyToMasterFile()
  
      Dim MasterWB As Workbook
      Dim MasterSht As Worksheet
      Dim MasterWBShtLstRw As Long
      Dim FolderPath As String
      Dim TempFile
      Dim CurrentWB As Workbook
      Dim CurrentWBSht As Worksheet
      Dim CurrentShtLstRw As Long
      Dim CurrentShtRowRef As Long
      Dim CopyRange As Range
      Dim ProjectNumber As String
  
  
      FolderPath = "C:\test\"
      TempFile = Dir(FolderPath)
  
      Dim WkBk As Workbook
      Dim WkBkIsOpen As Boolean
  
      'Check is zmaster is open already
      For Each WkBk In Workbooks
          If WkBk.Name = "zmaster.xlsx" Then WkBkIsOpen = True
      Next WkBk
  
      If WkBkIsOpen Then
          Set MasterWB = Workbooks("zmaster.xlsx")
          Set MasterSht = MasterWB.Sheets("Blad1")
      Else
          Set MasterWB = Workbooks.Open(FolderPath & "zmaster.xlsx")
          Set MasterSht = MasterWB.Sheets("Blad1")
      End If
  
      ProjectNumber = MasterSht.Cells(1, 1).Value
  
  
  
      Do While Len(TempFile) > 0
  
          'Checking that the file is not the master and that it is a xlsx
          If Not TempFile = "zmaster.xlsx" And InStr(1, TempFile, "xlsx", vbTextCompare) Then
  
              Set CopyRange = Nothing
  
              'Note this is the last used Row, next empty row will be this plus 1
              With MasterSht
                  MasterWBShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
              End With
  
              Set CurrentWB = Workbooks.Open(FolderPath & TempFile)
              Set CurrentWBSht = CurrentWB.Sheets("Sheet1")
  
              With CurrentWBSht
                  CurrentShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
              End With
  
              For CurrentShtRowRef = 1 To CurrentShtLstRw
  
               If CurrentWBSht.Cells(CurrentShtRowRef, "A").Value = ProjectNumber Then
  
                 'This is set to copy from Column A to Column L as per the question
  
                 If CopyRange Is Nothing Then
                   'If there is nothing in Copy range then union wont work
                   'so first row of the work sheet needs to set the initial copyrange
                    Set CopyRange = CurrentWBSht.Range("A" & CurrentShtRowRef & _
                                                  ":L" & CurrentShtRowRef)
                  Else
                    'Union is quicker to be able to copy from the sheet once
                    Set CopyRange = Union(CopyRange, _
                                          CurrentWBSht.Range("A" & CurrentShtRowRef & _
                                                              ":L" & CurrentShtRowRef))
                 End If  ' ending   If CopyRange Is Nothing ....
               End If ' ending  If CurrentWBSht.Cells....
  
              Next CurrentShtRowRef
  
              CopyRange.Select
  
              'add 1 to the master file last row to be the next open row
              CopyRange.Copy MasterSht.Cells(MasterWBShtLstRw + 1, 1)
  
              CurrentWB.Close savechanges:=False
  
          End If     'ending            If Not TempFile = "zmaster.xlsx" And ....
  
          TempFile = Dir
  
      Loop
  
  End Sub
  

---

在一篇文章中需要问很多问题。可能值得将其分为2或3篇文章。我会先从文件夹循环开始，一旦解决了这个问题，就有另一篇文章来询问格式化问题。此外，两个快照都显示相同的图片基本上我需要这个宏来循环目录，并且只复制匹配的数据主文件的A1和员工文件的A列。循环已经开始工作。但是，筛选器尚未添加到第一个宏中，我不知道如何添加这样的筛选器。这大概是我现在唯一需要的。感谢Dear Jean Pierre，感谢您的回复。但是，当我运行宏时，我收到以下消息：“zmaster.xlsx已打开”。然后行set masterwb=workbooks.open（folderpath&“zmaster.xlsx“被调试系统突出显示。知道什么可能导致此问题吗？@Frits，那是因为主文件已打开。请参阅更新的回答谢谢！这对我很有用，很好。最后一件事，excel是否可以忽略重复项？因此，如果我想再次更新该文件，它会忽略以前添加的数据（因此忽略相同的观察结果）。无论如何，非常感谢。@Frits，是的，这很容易通过转到“数据”选项卡并按“删除重复项”来完成。这也可以通过代码来完成，我认为这是另一个问题。