Excel以随机顺序将多个工作簿中的数据复制到主工作簿中

我已经编写了一些VBA代码，用于处理将数据从单个文件夹中的多个工作簿复制到另一个主工作簿，然后将结果绘制成图形。当运行宏时，它不会以正确的顺序复制数据。也就是说，曲线1被复制到曲线8应该去的地方。下面是处理整个文件夹选择和复制粘贴过程的代码

 Sub CopyDataBetweenWorkbooks()

    Dim wbSource As Workbook
    Dim shTarget As Worksheet
    Dim shSource As Worksheet
    Dim strFilePath As String
    Dim strPath As String

    ' Initialize some variables and
    ' get the folder path that has the files
    Set shTarget = ThisWorkbook.Sheets("5")
    strPath = GetPath

    ' Make sure a folder was picked.
    If Not strPath = vbNullString Then

        ' Get all the files from the folder
        strfile = Dir$(strPath & "*.xlsx", vbNormal)

        Do While Not strfile = vbNullString

            ' Open the file and get the source sheet
            Set wbSource = Workbooks.Open(strPath & strfile)
            Set shSource = wbSource.Sheets("Points")


            'Copy the data
            Call CopyData(shSource, shTarget)

            'Close the workbook and move to the next file.
            wbSource.Close False
            strfile = Dir$()
        Loop
    End If

End Sub

' Procedure to copy the data.
Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)

    Const strRANGE_ADDRESS As String = "B1:C26000"

    Dim lCol As Long

    'Determine the last column.
    lCol = shTarget.Cells(21, shTarget.Columns.Count).End(xlToLeft).Column + 2

    'Copy the data.
    shSource.Range(strRANGE_ADDRESS).Copy
    shTarget.Cells(21, lCol).PasteSpecial xlPasteValuesAndNumberFormats

    ' Reset the clipboard.
    Application.CutCopyMode = xlCopy

End Sub


' Fucntion to get the folder path
Function GetPath() As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Select a folder"
        .Title = "Folder Picker"
        .AllowMultiSelect = False

        'Get the folder if the user does not hot cancel
        If .Show Then GetPath = .SelectedItems(1) & "\"

    End With

End Function

---

如果有一种方法可以让我在不使用阵列的情况下实现更改，那将是最好的选择。

找到了！我只需要按顺序一步一步地遍历文件，一个接一个地调用它们，并遍历数字（使用这种方法，命名约定甚至可以是任何后跟数字的东西）甜美的Giblets，我做到了

 Sub CopyDataBetweenWorkbooks()

    Dim wbSource As Workbook
    Dim shTarget As Worksheet
    Dim shSource As Worksheet
    Dim strFilePath As String
    Dim strPath As String

    ' Initialize some variables and
    ' get the folder path that has the files
    Set shTarget = ThisWorkbook.Sheets("6")
    strPath = GetPath
    Filename = InputBox("What is the name of this File")
    FileCount = InputBox("How many file are you looking for")
    ' Make sure a folder was picked.
    If Not strPath = vbNullString Then

        ' Get all the files from the folder
        'strfile = Dir$(strPath & "*.xlsx", vbNormal)

        'Do While Not strfile = vbNullString
            For FileNumber = 1 To FileCount Step 1

                strfile = Filename & FileNumber & ".xlsx"

                ' Open the file and get the source sheet
                Set wbSource = Workbooks.Open(strPath & strfile)
                Set shSource = wbSource.Sheets("Points")


                'Copy the data
                Call CopyData(shSource, shTarget)

            'Close the workbook and move to the next file.
                wbSource.Close False
                'strfile = Dir$()
            Next 'FileNumber
        'Loop
    End If

End Sub

---

你的意思是

Dir$

没有按照你想要的顺序循环遍历文件吗？是的，没错。工作手册的标题如下：“曲线1”“曲线2”“曲线3”。。。。“curve10”但当我执行宏从每个工作簿中提取数据时，它会打开并随机复制数据。我确定“curve1”是先“编辑”的，而“curve10”是最后一个要编辑的，所以它们按名称和最后修改的顺序排列。

Dir$

不保证按字母顺序循环。。。一个选项是生成文件名列表并对其进行排序，如所示。