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

VBA-将计数器设置为循环以复制/粘贴到主表的下一列

1 个答案: