如何从一个工作表内的多个提取数据记录到另一个工作表中，并在数据后面加一个分隔标记。

Posted 2023-04-14

筛选，然后一个个复制
或者使用数据透视表的分页功能
都可以
参考技术A 筛选，然后一个个复制
或者使用数据透视表的分页功能
都可以
另外,站长团上有产品团购,便宜有保证

如何使用 Excel VBA 将特定行从多个工作表复制到另一个工作表？

【中文标题】如何使用 Excel VBA 将特定行从多个工作表复制到另一个工作表？

【英文标题】：How can I copy specific rows from several worksheets to another with Excel VBA?

【发布时间】：2018-11-21 09:24:54

【问题描述】：

每个月末我必须将数据（比如第 4 行复制到某些工作表的最后一行（比如工作表 2 - 7，但实际上有很多工作表和行）到工作表 1，从第 4 行开始粘贴工作表 1。

我尽我所能从堆栈溢出和其他网站中寻找答案。鉴于我是 VBA Excel 的外行，我无法真正根据我的情况自定义这些代码。

如果有人能帮帮我，我将不胜感激。谢谢。

下面是我自己做的一个失败的例子

Sub test1()
    Workbooks.Open Filename:="file location"
    Worksheets(2).Activate
    a = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    For a1 = 3 To a        
        Worksheets(2).Row(a1).Copy
        Worksheets(1).Activate
        Worksheets(1).Rows(a).PasteSpecial
    Next
End Sub

谢谢亚历克斯。我参考你的修改了代码。 后来我发现像下面这样编写我的代码并没有真正有效，因为要复制大约 100 个工作表和要粘贴 7 个主列表。下面是修改后的代码，用“do if”函数编写似乎更高效？假设 VBA 将工作表 2-10 第 4 行复制到工作表 1，然后开始将工作表 12-21 第 4 行复制到工作表 21

Sub test2()

'
Workbooks.Open Filename:="file location"

Worksheets(2).Rows("1:3").Copy Destination:=Worksheets(1).Rows(1)
Worksheets(1).Range("A:AG").ColumnWidth = 20
Worksheets(1).Range("AD:AD").ColumnWidth = 65
'
'
Worksheets(2).Activate
a = Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Row

Set rangeToCopy = Worksheets(2).Range(Cells(4, 1), Cells(a, 33))
rangeToCopy.Copy
Dim lastRow As String
lastRow = Worksheets(1).Cells(Rows.Count, "e").End(xlUp).Row + 1
Worksheets(1).Cells(lastRow, 1).PasteSpecial ' lastRow,1

Application.CutCopyMode = False
Set rangeToCopy = Nothing
'
'
'
Worksheets(3).Activate
b = Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Row

Set rangeToCopy = Worksheets(3).Range(Cells(4, 1), Cells(b, 33))
rangeToCopy.Copy
Dim lastRow2 As String
lastRow2 = Worksheets(1).Cells(Rows.Count, "e").End(xlUp).Row + 1
Worksheets(1).Cells(lastRow2, 1).PasteSpecial ' lastRow2,1

Application.CutCopyMode = False
Set rangeToCopy = Nothing

.....to be continued
End Sub

【参考方案1】：

在没有任何循环的情况下复制插入 Range 数据更容易，如下所示：

Set rangeToCopy= worksheets(1).Range(Cells(1, 1), Cells(a, 100))'insert number of columns instead of 100
rangeToCopy.Copy
worksheets(2).Cells(1, 1).PasteSpecial Paste:=xlPasteValues' 1,1 - row, column where u want to insert your data

【讨论】：

谢谢亚历克斯。我参考你的修改了代码。但是我还有问题，请你看一下修改后的代码，再帮我一把好吗？