[VBA HELP] Copy Data.

sasils · Oct 10, 2019

Hi everyone,

I need help on VBA code to copy and merge data from 2 pivot tables into a single data set to be display in another sheet.

Below is data Sheet 1 in excel.

Pivot A
Shipto	Soldto	LV1	LV2	LV3
001	A	Local	NE	Manufacturer
002	B	Local	NE	Manufacturer
003	C	Global	CE	Trader
004	D	Global	CE	Whole Sale
005	E	Others	S	Mini Mart
006	E	Others	S	Mini Mart

Pivot B
Mat Code	Description	LV1	LV2
S001	AAA	Chemical	RM
S002	BBB	Chemical	RM
S003	CCC	Chemical	RM
S004	DDD	Chemical	RM
S005	EEE	Paper	PM
S006	FFF	Paper	PM

Final Data to use data from Pivot A and B into a data set in Sheet 2. The result should look like below.

Final Table
Shipto	Soldto	LV1	LV2	LV3	Mat Code	Description	LV1	LV2
1	A	Local	NE	Manufacturer	S001	AAA	Chemical	RM
1	A	Local	NE	Manufacturer	S002	BBB	Chemical	RM
1	A	Local	NE	Manufacturer	S003	CCC	Chemical	RM
1	A	Local	NE	Manufacturer	S004	DDD	Chemical	RM
1	A	Local	NE	Manufacturer	S005	EEE	Paper	PM
1	A	Local	NE	Manufacturer	S006	FFF	Paper	PM
2	B	Local	NE	Manufacturer	S001	AAA	Chemical	RM
2	B	Local	NE	Manufacturer	S002	BBB	Chemical	RM
2	B	Local	NE	Manufacturer	S003	CCC	Chemical	RM
2	B	Local	NE	Manufacturer	S004	DDD	Chemical	RM
2	B	Local	NE	Manufacturer	S005	EEE	Paper	PM
2	B	Local	NE	Manufacturer	S006	FFF	Paper	PM
3	C	Global	CE	Trader	S001	AAA	Chemical	RM
3	C	Global	CE	Trader	S002	BBB	Chemical	RM
3	C	Global	CE	Trader	S003	CCC	Chemical	RM
3	C	Global	CE	Trader	S004	DDD	Chemical	RM
3	C	Global	CE	Trader	S005	EEE	Paper	PM
3	C	Global	CE	Trader	S006	FFF	Paper	PM
4	D	Global	CE	Whole Sale	S001	AAA	Chemical	RM
4	D	Global	CE	Whole Sale	S002	BBB	Chemical	RM
4	D	Global	CE	Whole Sale	S003	CCC	Chemical	RM
4	D	Global	CE	Whole Sale	S004	DDD	Chemical	RM
4	D	Global	CE	Whole Sale	S005	EEE	Paper	PM
4	D	Global	CE	Whole Sale	S006	FFF	Paper	PM
5	E	Others	S	Mini Mart	S001	AAA	Chemical	RM
5	E	Others	S	Mini Mart	S002	BBB	Chemical	RM
5	E	Others	S	Mini Mart	S003	CCC	Chemical	RM
5	E	Others	S	Mini Mart	S004	DDD	Chemical	RM
5	E	Others	S	Mini Mart	S005	EEE	Paper	PM
5	E	Others	S	Mini Mart	S006	FFF	Paper	PM
6	E	Others	S	Mini Mart	S001	AAA	Chemical	RM
6	E	Others	S	Mini Mart	S002	BBB	Chemical	RM
6	E	Others	S	Mini Mart	S003	CCC	Chemical	RM
6	E	Others	S	Mini Mart	S004	DDD	Chemical	RM
6	E	Others	S	Mini Mart	S005	EEE	Paper	PM
6	E	Others	S	Mini Mart	S006	FFF	Paper	PM

Thank you so much for your help.

Cheers.

Jon Peltier · Oct 10, 2019

I wrote a bit of VBA. I assume:

the two important pivot tables are on the same worksheet,
there is only the one header row in the pivot tables,
that the pivot tables can be reliably identified by the labels in their top left cells,
and any other pivot tables in that worksheet don't have the same labels in their top left cells.

Make the worksheet with these two pivot tables the active sheet, and run this code.

Code:

Sub ProcessPivots()
  Dim ws1 As Worksheet
  Set ws1 = ActiveSheet
  
  ' identify pivot tables
  Dim pt1 As PivotTable, pt2 As PivotTable, pt As PivotTable
  For Each pt In ws1.PivotTables
    If pt.TableRange1.Cells(1, 1).Value = "Shipto" Then
      Set pt1 = pt
    ElseIf pt.TableRange1.Cells(1, 1).Value = "Mat Code" Then
      Set pt2 = pt
    End If
  Next
  If pt1 Is Nothing Or pt2 Is Nothing Then
    MsgBox "Couldn't identify both pivot tables.", vbCritical
    GoTo ExitSub
  End If
  
  ' insert new sheet
  Dim ws2 As Worksheet
  Set ws2 = Worksheets.Add(After:=ws1)
  
  'set up ranges
  Dim ptrange1 As Range, ptrange2 As Range
  Set ptrange1 = pt1.TableRange1
  Set ptrange2 = pt2.TableRange1
  Dim rows1 As Long, rows2 As Long
  rows1 = ptrange1.Rows.Count - 1
  rows2 = ptrange2.Rows.Count - 1
  Dim columns1 As Long, columns2 As Long
  columns1 = ptrange1.Columns.Count
  columns2 = ptrange2.Columns.Count
  
  ' headers
  ws2.Range("A1").Resize(, columns1).Value = ptrange1.Rows(1).Value
  ws2.Range("A1").Offset(, columns1).Resize(, columns2).Value = ptrange2.Rows(1).Value
  
  ' populate
  Dim ptrange2a As Range
  Set ptrange2a = ptrange2.Offset(1).Resize(rows2)
  Dim loop1 As Long
  For loop1 = 1 To rows1
    ws2.Range("A1").Offset(1 + (loop1 - 1) * rows2).Resize(rows2, columns1).Value = ptrange1.Rows(1 + loop1).Value
    ws2.Range("A1").Offset(1 + (loop1 - 1) * rows2, columns1).Resize(rows2, columns2).Value = ptrange2a.Value
  Next
  
ExitSub:
End Sub

sasils · Oct 14, 2019

Hello,

Thank you for your help here, some clarification as I try it and it encounter error "MsgBox "Couldn't identify both pivot tables.", vbCritical"
- Do I have to change the name of pivot table to pt1 and pt2
- The 1st column in pt1 "Ship-to" is located in cell A9, it is impacted in above code is it to do with Range
- The 1st column in pt2 "Mat Code" is located in cell Q12, it is impacted in above code is it to do with Range
Thanks

Jon Peltier · Oct 15, 2019

pt1 and pt2 are the variables used by VBA. I tried to make it easy, so you didn't have to rename pivot tables.

The two pivot tables must have "Shipto" and "Mat Code" in their respective top left cells, as your first post showed. If one has "Ship-to" instead, the code will not find it.

If you want to rename the pivot tables, it may make the code generally more reliable (though if the condition in the above sentence is followed exactly, my code is reliable), name them "Pivot A" and "Pivot B" the way you labeled them in your first post. Then this code should work:

Code:

Sub ProcessPivots()
  Dim ws1 As Worksheet
  Set ws1 = ActiveSheet
  
  ' identify pivot tables
  Dim pt1 As PivotTable, pt2 As PivotTable
  On Error Resume Next
  Set pt1 = ws1.PivotTables("Pivot A")
  Set pt2 = ws1.PivotTables("Pivot B")
  On Error Goto 0
  If pt1 Is Nothing Or pt2 Is Nothing Then
    MsgBox "Couldn't identify both pivot tables.", vbCritical
    GoTo ExitSub
  End If
  
  ' insert new sheet
  Dim ws2 As Worksheet
  Set ws2 = Worksheets.Add(After:=ws1)
  
  'set up ranges
  Dim ptrange1 As Range, ptrange2 As Range
  Set ptrange1 = pt1.TableRange1
  Set ptrange2 = pt2.TableRange1
  Dim rows1 As Long, rows2 As Long
  rows1 = ptrange1.Rows.Count - 1
  rows2 = ptrange2.Rows.Count - 1
  Dim columns1 As Long, columns2 As Long
  columns1 = ptrange1.Columns.Count
  columns2 = ptrange2.Columns.Count
  
  ' headers
  ws2.Range("A1").Resize(, columns1).Value = ptrange1.Rows(1).Value
  ws2.Range("A1").Offset(, columns1).Resize(, columns2).Value = ptrange2.Rows(1).Value
  
  ' populate
  Dim ptrange2a As Range
  Set ptrange2a = ptrange2.Offset(1).Resize(rows2)
  Dim loop1 As Long
  For loop1 = 1 To rows1
    ws2.Range("A1").Offset(1 + (loop1 - 1) * rows2).Resize(rows2, columns1).Value = ptrange1.Rows(1 + loop1).Value
    ws2.Range("A1").Offset(1 + (loop1 - 1) * rows2, columns1).Resize(rows2, columns2).Value = ptrange2a.Value
  Next
  
ExitSub:
End Sub

sasils · Oct 15, 2019

Hello Jon,

Thank you for helping me, it work great now. Few small things. when it create a new sheet. It actually copy the header of Pivot 1 and value of Pivot 2 columns like below. I dont need header to be there, just need values from the pivot table to be copy. HOw to change the code on this. Also I would like the data to be inserted into existing sheet name "Data" starting row 59.

Thank you for your help.

Customer	Name 1	Sales Group	Matcode	Description EN
Customer	Name 1	Sales Group	S100003500	น้ำตาลทรายดิบ A (เทกอง)Bonsucro
Customer	Name 1	Sales Group	S100009800	Raw A Sugar (Bulk) OFF SPEC
Customer	Name 1	Sales Group	S100009900	น้ำตาลทรายดิบ A (เทกอง)
Customer	Name 1	Sales Group	S100109900	น้ำตาลทรายดิบ (1000KG)NoMark
Customer	Name 1	Sales Group	S100120000	น้ำตาลทรายดิบมิตรผล (1000KG)
Customer	Name 1	Sales Group	S100220000	น้ำตาลทรายดิบ A (500KG)
Customer	Name 1	Sales Group	S100310000	น้ำตาลทรายดิบ A มิตรผล (50KG.)
Customer	Name 1	Sales Group	S110009900	น้ำตาลทรายดิบ B (เทกอง)
Customer	Name 1	Sales Group	S110220000	น้ำตาลทรายดิบ B (500KG)
Customer	Name 1	Sales Group	S13000990	น้ำตาลทรายดิบ (เทกอง)
Customer	Name 1	Sales Group	S130009900	น้ำตาลทรายดิบไฮโพล์มิตรผล (เทกอง)
Customer	Name 1	Sales Group	S130110000	น้ำตาลทรายดิบไฮโพล์มิตรผล (1000KG.)
Customer	Name 1	Sales Group	S130129900	น้ำตาลทรายดิบไฮโพล์ NoMark (1000KG)
Customer	Name 1	Sales Group	S130310000	น้ำตาลทรายดิบไฮโพล์มิตรผล (50KG.)
Customer	Name 1	Sales Group	S130510070	น้ำตาลทรายดิบไฮโพล์มิตรผล(25KG)REG-KOREA

Jon Peltier · Oct 16, 2019

These are minor modifications. As you become familiar with how VBA works, you'll be able to figure them out for yourself.

In the code below I've commented out the old lines and inserted the new lines.

Code:

Sub ProcessPivots()
  Dim ws1 As Worksheet
  Set ws1 = ActiveSheet
  
  ' identify pivot tables
  Dim pt1 As PivotTable, pt2 As PivotTable
  On Error Resume Next
  Set pt1 = ws1.PivotTables("Pivot A")
  Set pt2 = ws1.PivotTables("Pivot B")
  On Error Goto 0
  If pt1 Is Nothing Or pt2 Is Nothing Then
    MsgBox "Couldn't identify both pivot tables.", vbCritical
    GoTo ExitSub
  End If
  
  ' insert new sheet
  Dim ws2 As Worksheet
  ''Set ws2 = Worksheets.Add(After:=ws1) '' OLD
  Set ws2 = Worksheets("Data") '' NEW
  
  'set up ranges
  Dim ptrange1 As Range, ptrange2 As Range
  Set ptrange1 = pt1.TableRange1
  Set ptrange2 = pt2.TableRange1
  Dim rows1 As Long, rows2 As Long
  rows1 = ptrange1.Rows.Count - 1
  rows2 = ptrange2.Rows.Count - 1
  Dim columns1 As Long, columns2 As Long
  columns1 = ptrange1.Columns.Count
  columns2 = ptrange2.Columns.Count
  
  '' headers '' NO LONGER USED
  ''ws2.Range("A1").Resize(, columns1).Value = ptrange1.Rows(1).Value '' OLD
  ''ws2.Range("A1").Offset(, columns1).Resize(, columns2).Value = ptrange2.Rows(1).Value '' OLD
  
  ' populate
  Dim ptrange2a As Range
  Set ptrange2a = ptrange2.Offset(1).Resize(rows2)
  Dim loop1 As Long
  For loop1 = 1 To rows1
    ''ws2.Range("A1").Offset(1 + (loop1 - 1) * rows2).Resize(rows2, columns1).Value = ptrange1.Rows(1 + loop1).Value '' OLD
    ''ws2.Range("A1").Offset(1 + (loop1 - 1) * rows2, columns1).Resize(rows2, columns2).Value = ptrange2a.Value '' OLD
    ws2.Range("A59").Offset((loop1 - 1) * rows2).Resize(rows2, columns1).Value = ptrange1.Rows(1 + loop1).Value '' NEW
    ws2.Range("A59").Offset((loop1 - 1) * rows2, columns1).Resize(rows2, columns2).Value = ptrange2a.Value '' NEW
  Next
  
ExitSub:
End Sub

sasils · Oct 16, 2019

Hi,

The head values still there.... As Customer, Sale group, Matcode Description EN, i think it is to do with populate part of the code....can you help thank you so much.

Customer	Name 1	Sales Group	Matcode	Description EN
Customer	Name 1	Sales Group	S133071400	น้ำตาลซองแดงเอราวัณ SACHET(7G.10020)
Customer	Name 1	Sales Group	S133071500	น้ำตาลซองแดงSPASSO SACHET (7G.10020)
Customer	Name 1	Sales Group	S303070400	น้ำตาลบริสุทธิ์การบินไทย (7G.10020)
Customer	Name 1	Sales Group	S303072300	น้ำตาลบริสุทธิ์ Tables T1(7G10020)
Customer	Name 1	Sales Group	S403070400	น้ำตาลบริสุทธิ์ซองการบินไทย (7G.10020)
Customer	Name 1	Sales Group	S403071400	น้ำตาลบริสุทธิ์เอราวัณSACHET(7G.10020)
100013	บริษัท เนสท์เล่ (ไทย) จำกัด	D11	Matcode	Description EN
100013	บริษัท เนสท์เล่ (ไทย) จำกัด	D11	S133071400	น้ำตาลซองแดงเอราวัณ SACHET(7G.10020)
100013	บริษัท เนสท์เล่ (ไทย) จำกัด	D11	S133071500	น้ำตาลซองแดงSPASSO SACHET (7G.10020)
100013	บริษัท เนสท์เล่ (ไทย) จำกัด	D11	S303070400	น้ำตาลบริสุทธิ์การบินไทย (7G.10020)
100013	บริษัท เนสท์เล่ (ไทย) จำกัด	D11	S303072300	น้ำตาลบริสุทธิ์ Tables T1(7G10020)
100013	บริษัท เนสท์เล่ (ไทย) จำกัด	D11	S403070400	น้ำตาลบริสุทธิ์ซองการบินไทย (7G.10020)
100013	บริษัท เนสท์เล่ (ไทย) จำกัด	D11	S403071400	น้ำตาลบริสุทธิ์เอราวัณSACHET(7G.10020)
100015	บริษัท ควอลิตี้ คอฟฟี่ โปรดักท์ส	D11	Matcode	Description EN

Jon Peltier · Oct 16, 2019

Do your pivot tables have more than one row of headers at the top? This was one of the assumptions, based on your initial post. I built these two pivot tables based on that post:

sasils · Oct 16, 2019

Hi,

I think it has 2 header rows, one is empty and below it is header name...and I remove it in Pivot table and it worked now thank you.

[VBA HELP] Copy Data.

sasils

New Member

Excel Facts

Jon Peltier

MrExcel MVP

sasils

New Member

Jon Peltier

MrExcel MVP

sasils

New Member

Jon Peltier

MrExcel MVP

sasils

New Member

Jon Peltier

MrExcel MVP

sasils

New Member

Similar threads

Forum statistics

Share this page

[VBA HELP] Copy Data.

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock