Question

我试图将包含某些标题的长列表中的特定行复制到其自己的选项卡上。我有一个使用wholerow.copy目的地工作的系统：=但这非常不整齐，并且花了很长时间，因为我有一个runclick同时使用超过10个模块（必须使用超过3500行。

到目前为止，我有这个，但我知道粘贴部分缺失（我不确定要放什么）。这个基本格式对我来说非常适用于另一个用于格式化单元格的宏，但显然它并不完全相同。

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

基本上我希望将相关行复制到从i行开始的“Anasuria”表格中。

Answer 1

我已经修改了一些代码，它应该可以工作（只需根据需要编辑范围）。还有一件事：您是否考虑使用高级过滤器？我认为它会给你相同的结果。

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

VBA将粘贴阵列/范围复制到另一个选项卡上

1 个答案: