VBA复制粘贴数组/范围到另一个选项卡上

我试图复制包含特定标题的长列表中的特定行到它自己的选项卡上。 我有一个系统，使用wholerow.copy目的地：=但这是相当不整洁，花了很长时间，因为我有一个runclick一次超过10个模块（必须与超过3500行工作。

到目前为止，我有这个，但我知道粘贴部分丢失（我不确定本质上放什么）。 这个基本的格式对我来说在格式化单元格的另一个macros中效果很好，但显然它不是完全相同。

Sub Anasuria() Dim i As Long, LastRow As Long Dim phrases Dim rng1 As Range With Application .ScreenUpdating = False .DisplayStatusBar = False .Calculation = xlCalculationManual End With Sheets("Anasuria").Range("A40:AZ10000").ClearContents phrases = Array("ANASURIA-Central", "ANASURIA-Env. Trading Sys.", "ANASURIA-Fulmar", _ "COOK-Anasuria allocation", "GUILLEMOT-Fulmar Gas") With Sheets("Main") LastRow = .Range("A" & Rows.Count).End(xlUp).Row For i = 40 To LastRow If Not IsError(Application.match(.Range("A" & i).Value, phrases, 0)) Then If rng1 Is Nothing Then Set rng1 = Sheets("Anasuria").Range("A" & Rows.Count).End(xlUp).Offset(1) End If End If rng1.PasteSpecial Next i End With With Application .Calculation = xlCalculationAutomatic .DisplayStatusBar = True .ScreenUpdating = True End With End Sub 

基本上我想把相关的行复制到第一行的“Anasuria”表中。

Answer 1

我已经修改了你的代码，它应该工作（只需编辑范围，以满足您的需求）。 还有一件事：你认为使用高级filter？ 我想这会给你同样的结果。

 Sub Anasuria() Dim i As Long, LastRow As Long, LastRowAna As Long Dim phrases With Application .ScreenUpdating = False .DisplayStatusBar = False .Calculation = xlCalculationManual End With Sheets("Anasuria").Range("A1:AZ10").ClearContents phrases = Array("ANASURIA-Central", "ANASURIA-Env. Trading Sys.", "ANASURIA-Fulmar", _ "COOK-Anasuria allocation", "GUILLEMOT-Fulmar Gas") LastRow = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row LastRowAna = Sheets("Anasuria").Range("A" & Rows.Count).End(xlUp) For i = 1 To LastRow If Not IsError(Application.Match(Sheets("Main").Range("A" & i).Value, phrases, 0)) Then Sheets("Main").Range("A" & i).EntireRow.Copy Sheets("Anasuria").Range("A" & LastRowAna + 1) 'copy/paste part you needed ;) LastRowAna = LastRowAna + 1 End If Next i With Application .Calculation = xlCalculationAutomatic .DisplayStatusBar = True .ScreenUpdating = True End With End Sub