Forum Discussion
Rufus_Bertrand
Jul 02, 2021Brass Contributor
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...
- Jul 02, 2021
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.
Rufus_Bertrand
Jul 02, 2021Brass Contributor
Hans to the rescue again!
That's going to work great. I'm going to go through the macro and make sure I understand what it is you're having it do. I may reach out to you with a couple of questions next week, if that's ok?
thanks again!
Rufus
HansVogelaar
Jul 03, 2021MVP
Sure, go ahead.