簡體   English   中英

如果發現文本,則在另一工作表中復制同一行的特定單元格

[英]Copy specific cells of same row in another worksheet if text found

如果確定文本出現在“ H”列中,則需要將一行的特定單元格復制到同一模塊中的另一個工作表中。 我確實能夠復制整個列,但是我不能僅復制我真正想要的行的單元格。

Dim rango As Range
Dim i As Integer
Dim Source As Worksheet
Dim Target As Worksheet

Set Source = ActiveWorkbook.Worksheets("Sumas y Saldos")
Set Target = ActiveWorkbook.Worksheets("Check")

nfil = Source.Range("H9").End(xlDown).Row
i = 9
For Each rango In Source.Range("H8:H" & nfil)
    If rango = "REVISAR" Then
       Source.Rows(rango.Row).Copy Target.Rows(i)
       i = i + 1
    End If
Next rango
'2 second try of the code, this is what I try to do in the If to copy just that cells.
If rango = "REVISAR" Then
Source.Rows(rango.Column).Copy Target.Column(i)
Source.Range("G9:G" & nfil).Copy Destination:=Target.Range("A8:A" & nfil)
Source.Range("H9:H" & nfil).Copy Destination:=Target.Range("B8:B" & nfil)
Source.Range("I9:I" & nfil).Copy Destination:=Target.Range("C8:C" & nfil)
Source.Range("J9:J" & nfil).Copy Destination:=Target.Range("D8:D" & nfil)
Source.Range("K9:K" & nfil).Copy Destination:=Target.Range("E8:E" & nfil)
Source.Rows(rango.Row).Copy Target.Rows(i)
i = i + 1
End If

希望有人能幫助我...謝謝

您可以使用Range對象的AutoFilter()方法,如下所示(未經測試,注釋中的解釋):

Option Explicit

Sub main()
    Dim Target As Worksheet

    Set Target = ActiveWorkbook.Worksheets("Check")

    With ActiveWorkbook.Worksheets("Sumas y Saldos")
        With .Range("G8:K" & .Cells(.Rows.Count, "H").End(xlUp).Row) 'reference its columns G:K cells from row 8 down to last not empty one in column "H"
            .AutoFilter field:=2, Criteria1:="REVISAR" ' filter referenced cells on 2nd column "REVISAR" content
            If Application.WorksheetFunction.Subtotal(103, .Columns(2)) > 0 Then .SpecialCells(xlCellTypeVisible).Copy Destination:=Target.Range("A8:D8")              ' if any filtered cell then get their underlying cells
        End With
        .AutoFilterMode = False
    End With
End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM