时间戳

首页 > 解决方案 > vba 宏从多个工作表中依次粘贴数据

excel - vba 宏从多个工作表中依次粘贴数据

问题描述

我有一个 Excel 工作簿，其中包含具有相同布局的每个月的发票数据。我想知道是否有一个宏可以从每张纸上复制数据并将其一个接一个地粘贴。

所以第一张纸是 P1，然后是 P2、P3 等，直到 P12。我想要一个将 P1 数据粘贴到新工作表上的宏，然后将 P2 数据粘贴到其下方，然后将 P3 等粘贴到最后。

我想这将是某种 For 循环，但我不确定代码会是什么样子（我对 vba 很陌生）

先感谢您！！！

标签： excelvba

解决方案

因为细节非常有限，为了了解工作表的结构，我尝试创建通用代码，通过一些修改可以满足您的需求。 

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

推荐阅读