VBA - Установка счетчика в цикле для копирования / вставки в следующий столбец в мастер-листе

Question

извинения, так как это может быть не самым техническим вопросом.

Я экспериментировал с этим кодом, чтобы попытаться скопировать и вставить указанный диапазон ("de: e130") в столбец главной таблицы и для каждого последующего файла скопировать и вставить в следующий столбец.Мне удалось получить нижеприведенный файл, который, кажется, открывается и файлы и вставки только в один столбец, в отличие от вставки в последующий столбец.Я думаю, что в структуру должен быть встроен цикл, чтобы указать копировать / вставить для вставки в следующий последующий столбец на мастер-листе.

Вид застрял, любая помощь будет принята с благодарностью.текущий код ниже

Sub LoopThroughFolder()

    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Dim a As Integer
    Set Wb = ThisWorkbook


    MyDir = "L:\Research\Research project\potato\"
    MyFile = Dir(MyDir & "*.xlsx")
    ChDir MyDir
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False



    Do While MyFile <> ""

        Workbooks.Open (MyFile), UpdateLinks:=False

        With Worksheets("Sheet Guidelines")

            Rws = .Cells(Rows.Count, "A").End(xlUp).Row
            Set Rng = Range("D1:E130")

            Rng.Copy Wb.Worksheets("Sheet1").Cells(1, 1).End(xlUp).Offset(1, 1)

            ActiveWorkbook.Close True
        End With
        MyFile = Dir()
    Loop

End Sub

Answer 1

  Sub LoopThroughFolder()
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook, Wbtmp As Workbook, Sh As Worksheet
    Dim Rws As Long, Rng As Range
    Dim a As Integer, Clcnt As Long
    Set Wb = ThisWorkbook
    Clcnt = 1

    MyDir = "L:\Research\Research project\potato\"
    MyFile = Dir(MyDir & "*.xlsx")
    ChDir MyDir

    Application.ScreenUpdating = False

    Do While MyFile <> ""
        Set Wbtmp = Workbooks.Open(MyFile, True)
        For Each Sh In Wbtmp.Sheets
            If Sh.Name = "Sheet Guidelines" Then
                Sh.Range("D1:E130").Copy Wb.Sheets("Sheet1").Cells(1, Clcnt)
                Clcnt = Clcnt + 2
            End If
        Next Sh
        Wbtmp.Saved = True 'Assuming you DONT want to save the temporary workbook (no change to it so no point saving ?
        Wbtmp.Close
        MyFile = Dir()
    Loop

    Application.ScreenUpdating = True 'If you turn the screenupdating off, you want to turn it back on at some point
End Sub