Макрос vba для вставки данных из нескольких листов один за другим

Question

У меня есть книга Excel, в которой указаны данные по счетам за каждый месяц с идентичным форматом.Мне было интересно, есть ли макрос, который может копировать данные с каждого листа и вставлять их все один за другим.

Итак, первый лист - это P1, затем P2, P3 и т. Д. До P12.Я хочу макрос, который вставит данные P1 на новый лист, затем данные P2 прямо под ним, затем P3 и т. Д. До конца.

Я предполагаю, что это был бы какой-то цикл For, но я не уверен, как будет выглядеть код (я очень новичок в vba)

Заранее спасибо !!!

Answer 1

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

Option Explicit

Sub test()

Dim wsTest As Worksheet, ws As Worksheet
Dim LRW As Long, LRF As Long, LCW As Long

'Here we create a separate sheet namded wsFull to paste the data in it.
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets("wsFull")
On Error GoTo 0

If wsTest Is Nothing Then
    Worksheets.Add.Name = "wsFull"
End If

Set wsTest = ActiveWorkbook.Worksheets("wsFull")

'Here we loop all sheets except the new sheet named wsFull
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "wsFull" Then

        With ws
            'Here we find last column (using first row) & last row (using Column A) for each sheet we loop
            LRW = .Cells(.Rows.Count, "A").End(xlUp).Row
            LCW = .Cells(1, .Columns.Count).End(xlToLeft).Column
        End With

        'Here we find the last row of wsFull in order to find where we will paste the data in.
        LRF = wsTest.Cells(wsTest.Rows.Count, "A").End(xlUp).Row

            'We paste the data in column A
            If LRF = 1 And wsTest.Range("A1").Value = "" Then
                ws.Range(ws.Cells(1, 1), ws.Cells(LRW, LCW)).Copy wsTest.Range("A1")
            Else
                ws.Range(ws.Cells(1, 1), ws.Cells(LRW, LCW)).Copy wsTest.Range("A" & LRF + 1)
            End If

    End If

Next ws

End Sub