首页 文章

复制另一个工作表中的匹配行

提问于
浏览 次
2

我有两个表格，第1页和第2页 . 我正在查看sheet1的第T列并粘贴完整的行，如果T在第2页中包含1.代码，效果很好，但它将结果粘贴在sheet1的同一行中的sheet2中 . 这导致行之间的空白 . 任何人都可以建议，我应该改变我的代码，以便我按顺序得到它们没有任何空行 . 另外，如何将第1行中的页眉从第1页复制到第2页？

Sub Test()
For Each Cell In Sheets(1).Range("T:T")
    If Cell.Value = "1" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

        Sheets(2).Select
        ActiveSheet.Rows(matchRow).Select
        ActiveSheet.Paste
        Sheets(1).Select
    End If
Next
End Sub
excel vba excel-vba

2 回答

  • 2

    没有必要使用 Select 和 Selection 来复制粘贴，它只会减慢代码的运行时间 .

    Option Explicit

Sub Test()

Dim Cell As Range
Dim NextRow as Long

Application.ScreenUpdating = False

For Each Cell In Sheets(1).Range("T1:T" & Sheets(1).Cells(Sheets(1).Rows.Count, "T").End(xlUp).Row)
    If Cell.Value = "1" Then
        NextRow = Sheets(2).Cells(Sheets(2).Rows.Count, "T").End(xlUp).Row
        Rows(Cell.Row).Copy Destination:=Sheets(2).Range("A" & NextRow + 1)
    End If
Next
Application.ScreenUpdating = True

End Sub
    回复于
  • 2

    Not For Points

    道歉，但我无法阻止自己发布答案 . 当我看到有人想要用一种低劣的做事方式时，我很痛苦:(

    我不赞成循环 . 与Autofilter相比，它非常慢 .

    如果你想使用循环，那么你可以通过不复制循环中的行但最后在 ONE GO 中使它更快......

    此外，如果你不喜欢危险地生活，那么总是完全限定你的对象，否则你可能最终会复制错误的行 .

    Option Explicit

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim lRow As Long, i As Long, r As Long
    Dim copyRng As Range

    Set wsI = Sheet1: Set wsO = Sheet2

    wsO.Cells.Clear

    '~~> first available row in sheet2
    r = 2

    With wsI
        lRow = .Range("T" & .Rows.Count).End(xlUp).Row

        '~~> Copy Headers
        .Rows(1).Copy wsO.Rows(1)

        For i = 1 To lRow
            If .Range("T" & i).Value = 1 Then
                If copyRng Is Nothing Then
                    Set copyRng = .Rows(i)
                Else
                    Set copyRng = Union(copyRng, .Rows(i))
                End If
            End If
        Next i
    End With

    If Not copyRng Is Nothing Then copyRng.Copy wsO.Rows(r)
End Sub

    Screenshot
    enter image description here

    回复于

相关问题