I'm trying to copy only the rows (not the entire row) from range E3:H until the end from the sheet test1 using the column H:H as parameter to check if a string matches on sheet test2 at the cell D1

For example.: If in sheet test2 the value of the cell D1 is dog, it must copy all the rows from the range C3:H of the sheet1 using the column H3:H of the sheet1 as parameter (if dog exists in some rows). So it should copy the matched rows for the sheet test2 in the colum M3

Well, it's beeing hard for me. Someone can help? Thank you

   Sub Test()
    Dim rw As Long, Cell As Range
    LastRow = Sheets("test1").Range("H" & Rows.Count).End(xlUp).Row
    
    For Each Cell In Sheets("test1").Range("H:H")
    rw = Cell.Row
     If Cell.Value = "D1" Then 'How do i define to take the value `D1` from sheet `test2`?
      Cell.Range("E3:H" & LastRow).Copy
       Sheets("test2").Range("M3:M" & LastRow & rw).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
     End If
    Next
    End Sub

CodePudding user response：

this should work, have a test let me know how you get on with it

note: there are more efficient ways of doing this but hopefully this is easier to follow and should be plenty fast enough

Sub Test()
    Dim rw As Long, rng As Range, ws As Worksheet
    Set ws = ThisWorkbook.Sheets("sheet1")
    LastRow = ws.Range("H" & Rows.Count).End(xlUp).Row
    Dog = Sheets("test2").Range("D1").Value
    i = 3
    
    For Each rng In ws.Range("H3:H" & LastRow)
        rw = rng.Row
        If rng.Value = Dog Then
            Sheets("test2").Range("M" & i & ":R" & i).Value = ws.Range("C" & rw & ":H" & rw).Value
            i = i   1
        End If
    Next rng
End Sub

CodePudding user response：

Copy Rows

• This is a basic code. Copying by assignment (drrg.Value = srrg.Value) instead of using PasteSpecial xlPasteValues is the only implementation to increase efficiency.

Option Explicit

Sub CopyRows()
    
    ' 1. Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' 2. Source
    
    ' Reference the source worksheet ('sws').
    Dim sws As Worksheet: Set sws = wb.Worksheets("Test1")
    ' Calculate the source last row ('slRow'),
    ' the row of the last non-empty cell in the column.
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "H").End(xlUp).Row
    ' Reference the source columns range ('scrg') whose rows will be copied.
    Dim scrg As Range: Set scrg = sws.Columns("E:H")
    
    ' 3. Destination
    
    ' Reference the destination worksheet ('dws').
    Dim dws As Worksheet: Set dws = wb.Worksheets("Test2")
    ' Reference the first destination row range by resizing the first
    ' destination cell by the number of columns of the source columns range.
    Dim drrg As Range: Set drrg = dws.Range("M3").Resize(, scrg.Columns.Count)
    ' Write the lookup string value to a string variable ('dlString').
    Dim dlString As String: dlString = CStr(dws.Range("D1").Value)
    
    ' 4. The Loop
    
    ' Declare additional variables.
    Dim srrg As Range ' Current Source Row Range
    Dim sr As Long ' Current Row in the Source Worksheet
    Dim slString As String ' Current String Lookup String
    
    ' Loop through the designated rows of the source worksheet.
    For sr = 3 To slRow
        ' Write the source string value in the current row to a variable.
        slString = CStr(sws.Cells(sr, "H").Value)
        ' Compare the string in the current row against the lookup string.
        ' The comparison is case-insensitive i.e. 'dog = DOG'
        ' due to the 'vbTextCompare' parameter.
        If StrComp(slString, dlString, vbTextCompare) = 0 Then ' is equal
            ' Reference the source row range.
            Set srrg = scrg.Rows(sr)
            ' Write the values from the source row range
            ' to the destination row range ('copy by assignment').
            drrg.Value = srrg.Value
            ' Reference the next destination row range (one row below).
            Set drrg = drrg.Offset(1)
        'Else ' is not equal; do nothing
        End If
    Next sr
    
    ' 5. Inform to not wonder if the code has run or not.
    MsgBox "Rows copied.", vbInformation
        
End Sub