VBA Codes On Combine Data

[Mel0620]

Hi Excel gurus:

I am trying to create a VBA codes in excel using below codes but I ran into error:

This is what I intended to do:

1. Copy data from Sheet A (specific to 3 columns only) to Summary sheet
2. Copy data from Sheet B (specific to 3 columns only) to Summary sheet
3. Arrange the copied data in summary tab and delete duplicate data

Sub CombineData()

'CopyPasteSage

'Sheets("Sage_Pivot").Select
Range("A5:C5").Select
Range("A5:C5").Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Sheets("Top Sheet").Select
Range("A24:C24").Select
Range("A24:C24").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'CopyPasteAccrual

'Sheets("PCard Accrual_Pivot").Select
Range("K5").Select
Range("K5").Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Sheets("Top Sheet").Select
Range("A24").End(xlDown).Offset(1, 0).Select
Range("A24").Offset(-1, 6).Copy Destination:=Range("A24").Offset(-1, 1)

'Sheets("PCard Accrual_Pivot").Select
Range("M5:N5").Select
Range("M5:N5").Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Sheets("Top Sheet").Select
Range("B4:C24").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A24").End(xlDown).Offset(1, 0).Select


'Sheets("Top Sheet").Select
Range("A24", Range("A24").End(xlDown)).Rows.RemoveDuplicates Columns:=1, Header:=xlYes

Dim Table As PivotCache
For Each Table In ThisWorkbook.PivotCaches

Table.Refresh

Next Table

End Sub

 

[DanteAmor]

According to your macro, you copy the data from row 5 and paste it into row 24. But I really don't know where the headers are at the source and at the destination.
Maybe those rows need to be adjusted in the macro.

Try this:

Sub CombineData()
  Dim sh3 As Worksheet
  Dim lr2 As Long, lr3 As Long
  Dim Table As PivotCache
  
  Application.ScreenUpdating = False
  Set sh3 = Sheets("Top Sheet")
  sh3.Range("A24:C" & Rows.Count).ClearContents
  
  With Sheets("Sage_Pivot")
    .Range("A5:C" & .Range("A:C").Find("*", , xlValues, , xlByRows, xlPrevious).Row).Copy
    sh3.Range("A24").PasteSpecial xlPasteValues
  End With
  
  With Sheets("PCard Accrual_Pivot")
    lr2 = .Range("K:N").Find("*", , xlValues, , xlByRows, xlPrevious).Row
    .Range("K5:K" & lr2 & ",M5:N" & lr2).Copy
    sh3.Range("A" & sh3.Range("A:C").Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1).PasteSpecial xlPasteValues
  End With
  
  lr3 = sh3.Range("A:C").Find("*", , xlValues, , xlByRows, xlPrevious).Row
  sh3.Range("A24:C" & lr3).Rows.RemoveDuplicates Columns:=1, Header:=xlYes
  
  For Each Table In ThisWorkbook.PivotCaches
    Table.Refresh
  Next Table
  Application.ScreenUpdating = True
End Sub

 

[Mel0620]

Thank you, this is awesome.

 

[Mel0620]

I have a concern on removing duplicates, my goal is to remove duplicates but keeping the first one.