如何将文件夹中的多个源工作簿中的数据复制到另一个工作簿，然后另存为新工作簿

Posted 2023-02-19

【中文标题】如何将文件夹中的多个源工作簿中的数据复制到另一个工作簿，然后另存为新工作簿

【英文标题】：How to copy data from multiple source workbooks within a folder to another workbook thereafter saving as a new workbook

【发布时间】：2021-07-05 19:41:18

【问题描述】：

我需要从工作表中复制特定行并将其粘贴到另一个工作簿表中。之后将文件另存为新工作簿。

这需要在一个文件夹中的许多工作簿上完成。对于每个源工作簿复制数据行，将其粘贴到主工作簿中并将工作簿另存为新工作簿。我需要 10 个主工作簿，因为有 10 个源工作簿。

这是我的工作簿所在的位置。

这是源工作簿文件的示例。

我需要复制没有标题的数据，所以第 2 行。这需要对上面文件夹中的所有文件进行。所有文件都具有相同的布局，只有数据所在的第 2 行。

主/目标工作簿

数据应粘贴到第 9 行。此模板化工作簿位于不同的文件夹中。

当前代码增加行数。我需要为每个源工作簿创建一个新的主工作簿，然后以源工作簿名称作为后缀保存主工作簿示例“主工作簿-AAAA”.xlsx

Option Explicit
Const FOLDER_PATH = "C:\Users\\Desktop\Split Files\"  'REMEMBER END BACKSLASH' 

Sub ImportWorksheets()    
    'Process all Excel files in specified folder'     
    Dim sFile As String  'file to process   
    Dim wsTarget As Worksheet    
    Dim wbSource As Workbook    
    Dim wsSource As Worksheet  
    Dim rowTarget As Long         'output row

    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 

Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True 
End Function

结果如下图

更新。

我尝试了不同的方法，但是工作簿崩溃了。

【问题讨论】：

您需要 (1) 列出文件夹中的所有工作簿，(2) 打开工作簿，(3) 在工作簿中查找特定工作表，(4) 在工作表中查找特定行, (5) 将一个工作表中的一行复制到另一个工作簿中的工作表中，(6) 保存另一个工作簿。你对哪一块有问题？

嗨，尼古拉斯。我对（5）和（6）有问题。所以目前我可以将位于文件夹中的所有源工作簿的第 2 行的数据保存到主工作簿第 9 行。但这不是我需要的解决方案，因为我在 1 个主工作簿中增加了它的代码。我需要的解决方案是创建一个循环，该循环将从源工作簿复制第 2 行并将其粘贴到主工作簿的第 9 行，然后将其保存为新工作簿 x 10，因为有 10 个源工作簿。

我假设您想从模板创建新的主工作簿，对吗？新工作簿要保存到哪里？

您好。是的，我想从模板创建新的主工作簿。新工作簿需要保存在我桌面上的新文件夹中。

【参考方案1】：

 'open template
    Const MASTER = "path-to-file\master.xlsx"
    Set wbTarget = Workbooks.Open(MASTER)
    Set wsTarget = wbTarget.Sheets(1)
    wsTarget.Unprotect "password"

    Do While sFile <> ""

        ' read source
        Set wbSource = Workbooks.Open(sFolder & sFile, 1, 1) ' update links, readonly
        Set wsSource = wbSource.Sheets(1)

        ' create target
        wsTarget.Name = "DATABASE"
        wsTarget.Range("A" & ROW_TARGET).Resize(1, 9) = wsSource.Range("A2:I2").Value2
        wbTarget.SaveAs "path\to\Master_" & sFile
        wbSource.Close False
    
        sFile = Dir

    Loop
    wsTarget.protect "password"
    wbTarget.Close False

【讨论】：

您好。我会尽快尝试并反馈。非常感谢。

您好。我尝试了这种方法，但是我不确定我是否正确地进行了更改。请查看修改的截图。

@coder 在 FOLDER_PATH 值的末尾添加一个 `\`。

嗨 @CDP1802 我在 FOLDER_PATH 值的末尾添加了“\”。它只是打开主模板工作簿，但没有将任何新文件保存到该位置或任何东西。

@coder read source 下的 2 行错误。 MASTER 应该是 FOLDER_PATH 并且 sheet(DATABASE) 应该和我一样，假设它是您要从中复制的第一张工作表。