Excel 如何创建VBA宏，该宏将数据从文件夹中的多个源工作簿复制到另一个工作簿，然后另存为新工作簿

就我需要帮助的事情多讲点背景。我需要创建一个VBA宏，该宏将从工作表中复制一个特定行，并将其粘贴到另一个工作簿工作表中。然后将文件另存为新工作簿。我需要确保这个VBA是一个数组，这意味着这将需要在文件夹中的许多工作簿上完成。就是。对于每个源工作簿，复制数据行，将其粘贴到主工作簿中，并将工作簿另存为新工作簿。也就是说，我需要10本主工作簿，因为有10本源工作簿

这是我的作业本所在的地方

这是一个源工作簿文件的示例，如下所示。我需要复制没有标题的数据，所以第2行。需要对上述文件夹中的所有文件执行此操作。所有文件都具有与数据所在位置相同的布局，只有第2行

主工作簿/目标工作簿如下所示，应粘贴数据的行为第9行。此模板化工作簿位于其他文件夹中

下面是我当前使用的代码，它将源文件夹中多个工作簿中的数据行添加到主工作簿中，但这会增加行数。我需要帮助，了解如何为每个源工作簿创建新的主工作簿，然后使用源工作簿名称将主工作簿保存为后缀，例如“主工作簿AAAA”。xlsx

子导入工作表（）
“处理指定文件夹中的所有Excel文件”
将sFile设置为要处理的字符串文件
将目标作为工作表进行调整
将wbSource设置为工作簿
将wsSource设置为工作表
将行目标变暗为“长”输出行

       rowTarget = 9

       'check the folder exists    
      If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub   
      End If

       'reset application settings in event of error'    
        On Error GoTo errHandler    
       Application.ScreenUpdating = False

       'set up the target worksheet'    
       Set wsTarget = Sheets("DATABASE")

       'loop through the Excel files in the folder'    
       sFile = Dir(FOLDER_PATH & "*.xls*")    
       Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(1)
      
      'import the data'
      With wsTarget
         .Range("A" & rowTarget).Value = wsSource.Range("A2").Value
         .Range("B" & rowTarget).Value = wsSource.Range("B2").Value
         .Range("C" & rowTarget).Value = wsSource.Range("C2").Value
         .Range("D" & rowTarget).Value = wsSource.Range("D2").Value
         .Range("E" & rowTarget).Value = wsSource.Range("E2").Value
         .Range("F" & rowTarget).Value = wsSource.Range("F2").Value
         .Range("G" & rowTarget).Value = wsSource.Range("G2").Value
         .Range("H" & rowTarget).Value = wsSource.Range("H2").Value
         .Range("I" & rowTarget).Value = wsSource.Range("I2").Value
      End With
      
      'close the source workbook, increment the output row and get the next file'
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()    
      Loop

    errHandler:    
    On Error Resume Next   
    Application.ScreenUpdating = True

       'tidy up'    
         Set wsSource = Nothing    
         Set wbSource = Nothing     
         Set wsTarget = Nothing 
       End Sub 

私有函数FileFolderExists（strPath作为字符串）作为布尔值 如果不是Dir（strPath，vbDirectory）=vbNullString，则FileFolderExists=True结束函数

结果如下所示

只是更新一下

我尝试了一种不同的方法，如下所示。然而，工作簿正在崩溃。知道我做错了什么吗

'打开模板
Const MASTER=“文件路径\MASTER.xlsx”
设置wbTarget=工作簿。打开（主）
设置wsTarget=wbTarget.Sheets（1）
wsTarget.Unprotect“password”
在sFile“”时执行此操作
'读取源
设置wbSource=Workbooks.Open（sFolder&sFile，1，1）“更新链接，只读
设置wsSource=wbSource.Sheets（1）
“创建目标
wsTarget.Name=“数据库”
wsTarget.Range（“A”和ROW_TARGET）.Resize（1,9）=wsSource.Range（“A2:I2”）.Value2
wbTarget.SaveAs“路径\到\主文件”&文件
wbSource。关闭False
sFile=Dir
环
wsTarget.protect“密码”
wbTarget，关闭False

您需要（1）列出文件夹中的所有工作簿，（2）打开工作簿，（3）在工作簿中查找特定工作表，（4）在工作表中查找特定行，（5）将一行从一个工作表复制到另一个工作簿中的工作表，（6）保存另一个工作簿。你对哪一块有问题？嗨，尼古拉斯。我对（5）和（6）有问题。因此，目前我可以将位于文件夹中的所有源工作簿的第2行数据保存到主工作簿第9行。但这不是我需要的解决方案，因为我的代码在1主工作簿中增加了它。我需要的解决方案是创建一个循环，从源工作簿复制第2行，然后粘贴到主工作簿的第9行，然后将其另存为新工作簿x 10，因为有10个源工作簿。我假设您要从模板创建新的主工作簿，对吗？要保存到哪里的新工作簿？你好。是，我想从模板创建新的主工作簿。新工作簿需要保存在我桌面上的新文件夹中。您好。我会很快尝试并反馈。非常感谢。你好。我尝试了这种方法，但是我不确定我是否正确地进行了更改。请查看修改的屏幕截图。@coder在文件夹\u路径值的末尾添加一个“\”。@coder“读取源”下的两行是错误的。母版应该是文件夹路径，工作表（数据库）应该和我的一样，假设它是您要从中复制的第一张工作表。@coder

wsTarget.Name=“DATABASE”

       rowTarget = 9

       'check the folder exists    
      If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub   
      End If

       'reset application settings in event of error'    
        On Error GoTo errHandler    
       Application.ScreenUpdating = False

       'set up the target worksheet'    
       Set wsTarget = Sheets("DATABASE")

       'loop through the Excel files in the folder'    
       sFile = Dir(FOLDER_PATH & "*.xls*")    
       Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(1)
      
      'import the data'
      With wsTarget
         .Range("A" & rowTarget).Value = wsSource.Range("A2").Value
         .Range("B" & rowTarget).Value = wsSource.Range("B2").Value
         .Range("C" & rowTarget).Value = wsSource.Range("C2").Value
         .Range("D" & rowTarget).Value = wsSource.Range("D2").Value
         .Range("E" & rowTarget).Value = wsSource.Range("E2").Value
         .Range("F" & rowTarget).Value = wsSource.Range("F2").Value
         .Range("G" & rowTarget).Value = wsSource.Range("G2").Value
         .Range("H" & rowTarget).Value = wsSource.Range("H2").Value
         .Range("I" & rowTarget).Value = wsSource.Range("I2").Value
      End With
      
      'close the source workbook, increment the output row and get the next file'
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()    
      Loop

    errHandler:    
    On Error Resume Next   
    Application.ScreenUpdating = True

       'tidy up'    
         Set wsSource = Nothing    
         Set wbSource = Nothing     
         Set wsTarget = Nothing 
       End Sub