Question

我希望将workbook1中的VBA放入指定的文件夹中，打开其中的三个工作簿，然后将每个文件夹中的数据（文件夹中的每个工作簿只有一张包含数据的表）复制到workbook1中。

我到处找了很多信息来复印表格；如果我有工作簿名称和选项卡名称，则可以进入该文件夹并复制数据，但是每次加载新工作簿（每月）时，这些值都会更改。

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

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

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

这实际上不是一个问题，而是三个问题：找到工作簿，从名称中获取正确的图纸并复制内容。

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

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是一个函数，用于描述如何根据给定的源工作表确定复制范围。

最后，存在查找源工作簿的问题。在评论中，建议使用Dir。但是，我想提出一种更具可读性的方法。除非您在Mac上工作，否则可以在工具-> 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

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

我希望这对特定问题有帮助，并且通常在如何将此类问题分解为较小的问题方面可以有所帮助，这些问题可以在单独的过程或功能中处理。

将多个工作表复制到另一个工作簿中

1 个答案: