Matching data from two colums on separate sheets, and copying rows of matches to sheet 3

[jukurit]

I have information on two sheets. Sheets 1 and 2. I need to mach the data in sheet 1 column C with data in sheet 2 column P. If the numbers match i need the row in sheet 2 that has the matching number to be copied into sheet 3. (there are multiple numbers that match in sheet 2 and i set by sheet 1)
Suggestions please?

 

[Sektor]

Sub Collect()

    Dim sh As Worksheet
    Dim rng1 As Range, rng2 As Range, cell As Range
    
    Set sh = Sheets("Sheet3")
    
    With Sheets("Sheet1")
        Set rng1 = .Range("C1", .Range("C1").End(xlDown))
    End With
    With Sheets("Sheet2")
        Set rng2 = .Range("P1", .Range("P1").End(xlDown))
    End With
    
    For Each cell In rng2
        If WorksheetFunction.CountIf(rng1, cell.Value) Then
            sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = cell.Value
        End If
    Next

End Sub

 

[jukurit]

nothing happened. haha

 

[Sektor]

Of course nothing 'cause I wrote generic code. You should alter names of your sheets. If you'd write names of those two sheets and sheet to transfer data, I'd write it in code. Ha-ha

 

[jukurit]

im abit new to these macro thisngs. haha never done them before.
so ive named
sheet 1 = Yritys
sheet 2 = Yhteyshenkilo
sheet 3 = Valmis

 

[Sektor]

Try this one. Here code searches values from rng1 in rng2.

Sub Collect()

    Dim sh As Worksheet
    Dim rng1 As Range, rng2 As Range, cell As Range
    
    Set sh = Sheets("Valmis")
    
    With Sheets("Yritys")
        Set rng1 = .Range("C1", .Range("C1").End(xlDown))
    End With
    With Sheets("Yhteyshenkilo")
        Set rng2 = .Range("P1", .Range("P1").End(xlDown))
    End With
    
    For Each cell In rng2
        If WorksheetFunction.CountIf(rng1, cell.Value) Then
            sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = cell.Value
        End If
    Next

End Sub

 

[JackDanIce]

I've made a slight change to Sektor's code, try:

Sub Collect()
    Dim sh As Worksheet
    Dim rng1 As Range, rng2 As Range, cell As Range
 
    Set sh = Sheets("Valmis")
 
    With Sheets("Yritys")
        Set rng1 = .Range("C1", .Range("C1").End(xlDown))
    End With
    With Sheets("Yhteyshenkilo")
        Set rng2 = .Range("P1", .Range("P1").End(xlDown))
    End With
 
    For Each cell In rng2
        If WorksheetFunction.CountIf(rng1, cell.Value) Then
            cell.EntireRow.Copy
            sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
        End If
    Next
End Sub

 

[jukurit]

It is still not doing anything. i have posted the code in the macro. but nothing happens when i run it.

 

[JackDanIce]

You are not getting any error messages or anything?

 

[jukurit]

no. its just not doing anything when i run the macro.