Home Copy specific cells of same row in another worksheet if text found

# Copy specific cells of same row in another worksheet if text found

Guillermo
1#
Guillermo Published in 2018-02-14 16:05:27Z
 I need to copy specific cells of a row, to another worksheet in same bock, if determined Text appears in a "H" column. I´m alredy able to copy the entire column, but I´m not able to copy just the cells of the row I really want. 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  Hope someone can help me... Thanks
DisplayName
2#
 you could use AutoFilter() method of Range object, like follows (not tested, explanations in comments): 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