Excel копирует данные из нескольких рабочих книг в основную рабочую книгу в случайном порядке

Question

Я написал некоторый код VBA для обработки копирования данных из нескольких рабочих книг в одной папке в другую основную рабочую книгу, а затем составил график результатов. При запуске макроса он не копирует данные в правильном порядке. Ie. Curve1 копируется туда, где Curve8 должен go. Ниже приведен код, который обрабатывает весь процесс выбора папки и копирования и вставки.

 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

Если есть способ реализовать изменение без использования массива, который был бы наилучшим вариантом.

Answer 1

Нашли, ребята! Мне просто нужно было пройтись по файлам по порядку, позвонив им один за другим и пошагово пройдя по номерам (Соглашение об именовании может быть любым, за которым следует число с использованием этого метода) Сладкие Потрошки, я сделал это!

 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