Vba 将6个列匹配的工作簿中的数据复制到单个工作簿

Vba 将6个列匹配的工作簿中的数据复制到单个工作簿,vba,excel,Vba,Excel,我有6本不同的工作手册,每本至少3页。我需要一个VBA代码来自动生成主工作簿,其中包含来自other的匹配列 工作手册1-“基线” 工作手册2-“每日1” 工作手册2-“每日2” workboook daily3、daily4、daily5将具有与daily1和daily2相同的列 我已经填写了主表,作为您了解我的具体要求的示例。 注意:在我的主工作表中,ID、hstname、user、dept、loc、mac addr列取自“基线”工作簿。如果hstname列在“基线”和“daily1”工作簿

我有6本不同的工作手册,每本至少3页。我需要一个VBA代码来自动生成主工作簿,其中包含来自other的匹配列

工作手册1-“基线”

工作手册2-“每日1”

工作手册2-“每日2”

workboook daily3、daily4、daily5将具有与daily1和daily2相同的列

我已经填写了主表,作为您了解我的具体要求的示例。 注意:在我的主工作表中,ID、hstname、user、dept、loc、mac addr列取自“基线”工作簿。如果hstname列在“基线”和“daily1”工作簿中匹配,则将daily1工作簿的“结果”列复制到主工作簿的“daily1”列。每天重复同样的步骤2、3、4和5次。还要注意的是,不应该有任何重复的值(Master中有重复的hstnames)

母版纸

 ID hstname   daily1    daily2  daily3 d4 d5 User     Dept    Loc   MACAddr
  1 abcghj    yes       yes      yes          abc     aa      jay    1.2.3.
  2 sgtsx     notscan   no        no          sgt     ss      jay    4.56.8
  6 wrgyr      yes      yes       no          wrg     dd      jay    5.6.7
  4 dfhbnj,    yes    notscan     no         gdxvg    tt      jay    3.4.5.6.7
  8 24dvg5t    no       yes       yes            xb   ff      jay    9.8.56
尝试使用此代码。但它并没有完全达到目的

   Sub LoopThroughDirectory()
   Dim MyFile As String
   Dim erow
   Dim Filepath As String
   Filepath = "D:\examp\"
   MyFile = Dir(Filepath)
   Do While Len(MyFile) > 0
        If MyFile = "master.xlsx" Then
        Exit Sub
        End If

   Workbooks.Open (Filepath & MyFile)
   Range("A2:D2").Copy
   ActiveWorkbook.Close

   erow = Sheet1.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

如果您以前从未使用过VBA,可以尝试打开宏录制器并了解函数的功能。老实说,我们大多数人就是这样开始使用VBA的。一些值得学习的好网站是Ozgrid或Mr.Excel。我们需要检查一些代码,这将非常有助于您找到正确的方向。

您好,Apurva,Stackoverflow恐怕不是请求代码服务。也许可以向我们展示您将如何使用您熟悉的另一种编程语言来完成此操作。如果MyFile=“master.xlsx”,则Sub LoopThroughDirectory()Dim MyFile As String Dim erow Dim Filepath As String Filepath=“D:\examp\”MyFile=Dir(Filepath)do而Len(MyFile)>0然后退出子结束,如果工作簿。打开(文件路径和MyFile)范围(“A2:D2”)。复制活动工作簿。关闭erow=Sheet1。单元格(Rows.Count,1)。结束(xlUp)。偏移量(1,0)。行活动工作表。粘贴目标:=工作表(“Sheet1”)。范围(单元格(erow,1),单元格(erow,4))MyFile=Dir循环结束子请使用此信息编辑您的问题。我附上了一段代码,它只为1%的目的服务。
         hstname        OnlineStatus      result
          abcghj          scan             yes
           sgtsx          scan            yes
             wrgyr        scan            yes
             dfhbnj,      scan            yes
            sdrgswdeg     scan             no
 ID hstname   daily1    daily2  daily3 d4 d5 User     Dept    Loc   MACAddr
  1 abcghj    yes       yes      yes          abc     aa      jay    1.2.3.
  2 sgtsx     notscan   no        no          sgt     ss      jay    4.56.8
  6 wrgyr      yes      yes       no          wrg     dd      jay    5.6.7
  4 dfhbnj,    yes    notscan     no         gdxvg    tt      jay    3.4.5.6.7
  8 24dvg5t    no       yes       yes            xb   ff      jay    9.8.56
   Sub LoopThroughDirectory()
   Dim MyFile As String
   Dim erow
   Dim Filepath As String
   Filepath = "D:\examp\"
   MyFile = Dir(Filepath)
   Do While Len(MyFile) > 0
        If MyFile = "master.xlsx" Then
        Exit Sub
        End If

   Workbooks.Open (Filepath & MyFile)
   Range("A2:D2").Copy
   ActiveWorkbook.Close

   erow = Sheet1.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