excel - 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

标签： excelvbaloops

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