复制另一张表中匹配的行 [英] Copying the matched row in another sheet

问题描述

我有两个表格，sheet1和sheet2。
如果T在表2中包含1，我正在查看sheet1的列T并粘贴整行。
代码，工作得很好，但它将结果粘贴到sheet1中的sheet2中。
这将导致行之间的空白。任何人都可以建议，我应该用我的代码更改，这样我就可以顺序地得到它们，没有空行。
另外，如何将第1行的标题从表格1复制到sheet2？

  Sub Test（）
表格中的每个单元格（1）.Range（T：T）
如果Cell.Value =1，那么
 matchRow = Cell.Row 
 Rows（matchRow& amp ;：& matchRow）。选择
 Selection.Copy 
 
表格（2）。选择
 ActiveSheet.Rows（matchRow）。选择
 ActiveSheet.Paste 
表单（1）。选择
结束如果
下一个
结束子
  

解决方案

不需要使用选择和选择要复制粘贴，它只会减慢代码的运行时间。

  Option Explicit 
 
 Sub Test（）
 
 Dim Cell As Range 
 Dim NextRow as Long 
 
 Application.ScreenUpdating = False 
 
对于表格中的每个单元格1）.Range（T1：T& Sheets（1）.Cells（Sheets（1）.Rows.Count，T）。End（xlUp）.Row）
如果Cell.Value = 1然后
 NextRow = Sheets（2）.Cells（Sheets（2）.Rows.Count，T）。End（xlUp）.Row 
 Rows（Cell.Row）.Copy目的地： = Sheets（2）.Range（A& NextRow + 1）
如果
下一个
 Application.ScreenUpdating = True 
 
 End Sub 
  

I have two Sheets, sheet1 and sheet 2. I am looking into column T of sheet1 and pasting the complete row if T contains 1 in sheet 2. The code, works good, but it paste the result in sheet2 in the same row in sheet1. This results in blanks, between the rows. Can anyone suggest, what i should Change with my code, so that i get them in sequence without any blank rows. Also, how can I copy the Header in row 1 from sheet 1 to sheet2?

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

解决方案

There's no need to use Select and Selection to copy paste, it will only slows down your code's run-time.

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

这篇关于复制另一张表中匹配的行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！