Цикл VBA для копирования данных с динамического количества листов на первый лист, слишком много раз копируя

Question

Я все еще новичок в VBA, но я пытаюсь перебрать и скопировать динамический объем данных листов (они меняются ежемесячно и различаются по длине) и не включают первые два листа и последний лист. Данные начинаются с 6-й строки, и я хотел бы скопировать все содержимое в последнюю строку последней строки с именем Combined_Athlete. Приведенный ниже код на самом деле работает, но циклически перебирает данные 5 раз и копирует дубликаты контента на первую вкладку. Может кто-нибудь помочь и сказать мне, где я иду не так? Я установил вторую переменную для копирования данных из 6-й строки в последнюю, поскольку именно там она начинается, но я не уверен, является ли это причиной 5-кратного увеличения объема дополнительных данных, которые она копирует. Любая помощь приветствуется!

Sub CopyAndCombineSheets()

    Dim i As Integer
    Dim j As Integer
    Dim ws As Worksheet
    Dim LastRow As Long

    For i = 3 To Worksheets.Count - 1

        For Each ws In Worksheets
        Worksheets(i).Select

        LastRow = ThisWorkbook.ActiveSheet.UsedRange.Rows.Count

                For j = 6 To LastRow
                    ThisWorkbook.ActiveSheet.Rows(j).Copy Sheets("Combined_Athlete").Range("A" & Sheets("Combined_Athlete").Range("A" & Rows.Count).End(xlUp).Row + 1)
                Next j

        Next ws

    Next i

End Sub

Answer 1

Вы дважды просматриваете все листы. Попробуйте что-то вроде этого:

For Each ws In Worksheets
    If ws.Name <> "Combined_Athlete" then
        LastRow = ws.UsedRange.Rows.Count
        For j = 6 To LastRow
            ws.Rows(j).Copy Sheets("Combined_Athlete").Range("A" & Sheets("Combined_Athlete").Range("A" & Rows.Count).End(xlUp).Row + 1)
        Next j
    End if
Next ws