Forum Discussion

Rufus_Bertrand's avatar
Rufus_Bertrand
Brass Contributor
Jul 02, 2021
Solved

Excel help with copying rows from 2 sheets to new sheet

I have a workbook with Sheet1 and Sheet2.  Sheet1 columns are 'SSN' and '2019 Hours'.  Sheet2 columns are 'SSN' and '2020 Hours'. I need to match Sheet1 column 'SSN' to Sheet2 column 'SSN' and creat...
  • HansVogelaar's avatar
    Jul 02, 2021

    Rufus_Bertrand 

    Here is a macro:

    Sub CombineSheets()
        ' Change the constants to the actual names of your sheets
        Const sh1 = "Sheet1"
        Const sh2 = "Sheet2"
        Dim ws1 As Worksheet
        Dim ws2 As Worksheet
        Dim ws3 As Worksheet
        Dim col As New Collection
        Dim r As Long
        Dim m1 As Long
        Dim m2 As Long
        Dim v As Variant
        Application.ScreenUpdating = False
        Set ws1 = Worksheets(sh1)
        m1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
        On Error Resume Next
        For r = 2 To m1
            col.Add Key:=CStr(ws1.Range("A" & r).Value), Item:=ws1.Range("A" & r).Value
        Next r
        On Error GoTo 0
        Set ws2 = Worksheets(sh2)
        m2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
        On Error Resume Next
        For r = 2 To m2
            col.Add Key:=CStr(ws2.Range("A" & r).Value), Item:=ws2.Range("A" & r).Value
        Next r
        On Error GoTo 0
        Set ws3 = Worksheets("Sheet3")
        ws3.Range("A1:C1").Value = Array("SSN", "2019 HRS", "2020 HRS")
        r = 2
        For Each v In col
            ws3.Range("A" & r).Value = v
            r = r + 1
        Next v
        ws3.Range("B2:B" & col.Count + 1).Formula = "=IFERROR(VLOOKUP(A2,'" & sh1 & "'!$A$2:B$" & m1 & ",2,FALSE),"""")"
        ws3.Range("C2:C" & col.Count + 1).Formula = "=IFERROR(VLOOKUP(A2,'" & sh2 & "'!$A$2:B$" & m2 & ",2,FALSE),"""")"
        Application.ScreenUpdating = True
    End Sub

    See the attached version, now a macro-enabled workbook. Make sure that you allow macros when you open it.

Resources