将多个工作表复制到不同的工作簿中

Question

我想让工作簿 1 中的 VBA 进入指定文件夹，打开其中的三个工作簿，然后将每个工作簿中的数据（文件夹中的每个工作簿只有一张带有数据的工作表）复制到工作簿 1。

我环顾四周，找到了很多复印工作表的信息；如果我有工作簿名称和选项卡名称，我可以进入文件夹并复制数据，但每次加载新工作簿时（每月）这些都会改变。

Sub OpenWorkbook1()


'Open workbook
Workbooks.Open "P:\FSD\SUPPORT SERVICES\File Load\190731_CO.xls"

'Copy


Workbooks("190731_CO.xls").Worksheets("190731_CO").Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

'Paste
Workbooks("Dual Sub.xlsm").Worksheets("CO").Range("A2").PasteSpecial 
Paste:=xlPasteValues

Application.CutCopyMode = False
Workbooks("190731_CO.xls").Close SaveChanges:=False

End Sub

上面的代码没问题，但是我希望每个月都能打开工作簿，并且数字（本例中为 190731）会每月更改为随机数。我需要从 3 个工作簿中提取数据，以上仅显示我从其中一个工作簿中收集数据。

Answer 1

根据我从描述中收集到的信息，问题如下。

目的是将仅包含这三个工作簿的指定文件夹中三个工作簿的第一个工作表的内容复制到已知工作簿中，以最后一个下划线后面的字母命名的工作表。

这实际上不是一个问题，而是三个问题：找到工作簿、从名称中导出正确的工作表和复制内容。

您已经处理了最后一个问题，但不是很通用。 cmets 中链接的答案可以进一步帮助您。但是，由于您只关心值，因此我建议您通过数组进行复制。

Private Sub CopyValues(ByVal sourceRange As Excel.Range, ByVal targetRange As Excel.Range)
    Dim copyArray as Variant
    copyArray = sourceRange.Value
    targetRange.Value = copyArray
End Sub

要获取目标工作表的名称，可以使用 VBA atring functions；特别是 InstrRev Right 和 Split 可能有用。我会让你想办法定义一个函数Private Function TargetSheetName(ByVal sourceWorkbookName As String)。

使用此信息，您可以执行以下操作。

Private Sub CopyFirstSheet(ByVal sourceWorkbook As Excel.Workbook, ByVal targetWorkbook As Excel.Workbook)
    Dim sourceRange As Excel.Range
    Set sourceRange = CopyRange(sourceWorkbook.Worksheets(1)
    Dim targetSheetName As String
    targetSheetName = TargetSheetName(targetWorkbook.Name)
    Dim targetRange As Excel.Range
    Set targetRange = targetWorkbook.Worksheets(targetSheetName).Range("A2")
End Sub

这里的Private Function CopyRange(ByVal sourceWorksheet As Excle.WorkSheet) As Excel.Range 是一个函数，描述了在给定源工作表的情况下如何确定复制范围。

最后，还有寻找源工作簿的问题。在 cmets 中，建议使用Dir。但是，我想建议一种更具可读性的方法。除非您在 Mac 上工作，否则您可以参考 Tools->Refreences 下的库 _Microsoft Scripting Runtime`。这使您可以访问Scripting.FileSystemObject。您可以按如下方式使用它。

Private Sub CopyFromFolder(ByVal sourcePath As String, ByVal targetWorkbook As Excel.Workbook)
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    Dim file As Scripting.File
    For Each file in fso.GetFolder(path).Files
        Dim sourceWorkbook As Excel.Workbook
        Set sourceWorkbook = Application.Workbooks.Open path & file.Name
        CopyFirstSheet sourceWorkbook, targetWorkbook 
        sourceWorkbook.Close SaveChanges:=False
    Next
End Sub

这假定文件夹中只有三个工作簿。否则，将需要更多的逻辑。

我希望这对特定问题以及如何将此类问题拆分为可以在单独的过程或功能中处理的较小问题有所帮助。