Data combination - VBA requires modification

Status
Not open for further replies.

Aberdham

Board Regular
Joined
Mar 8, 2018
Messages
163
Office Version
  1. 365
Platform
  1. Windows
Hi Excel masters,

I have tested the below code on my workbook:

Option Explicit
Public Sub CombineDataFromAllSheets()

Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long

'Notes: "Src" is short for "Source", "Dst" is short for "Destination"

'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("overview machine 1")
lngDstLastRow = LastOccupiedRowNum(wksDst)
lngLastCol = LastOccupiedColNum(wksDst)

'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

'Loop through all sheets
For Each wksSrc In ThisWorkbook.Worksheets

'Make sure we skip the "overview machine 1" destination sheet!
If wksSrc.Name <> "Import" Then

'Identify the last occupied row on this sheet
lngSrcLastRow = LastOccupiedRowNum(wksSrc)

'Store the source data then copy it to the destination range
With wksSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
rngSrc.Copy Destination:=rngDst
End With

'Redefine the destination range now that new data has been added
lngDstLastRow = LastOccupiedRowNum(wksDst)
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

End If

Next wksSrc

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last column
'OUTPUT : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
End Function
And here are the output data:

there are altogether 120 of machine, I will demonstrate below the 3 output sheets of the respective machine:

sheet 1 (historical cost) would look like:
[TABLE="class: cms_table_cms_table, width: 1327"]
<tbody>[TR]
[TD]Invoice type[/TD]
[TD]Invoice Number[/TD]
[TD]Supplier/Debitor[/TD]
[TD]Description[/TD]
[TD]Invoice Date[/TD]
[TD]FX rate[/TD]
[TD]USD Amount[/TD]
[TD]EUR Amount[/TD]
[TD]Change in Inventory[/TD]
[TD]Machinery[/TD]
[TD]Category[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]K8554214[/TD]
[TD]ADA[/TD]
[TD]Deposit SN 844451[/TD]
[TD="align: right"]01/12/2017[/TD]
[TD="align: right"]1,1885[/TD]
[TD]$361.067,54[/TD]
[TD="align: right"]303.801,05 €[/TD]
[TD="align: right"]-303.801,05 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]K8554215[/TD]
[TD]ADA[/TD]
[TD]final payment_ESN 848462[/TD]
[TD="align: right"]01/01/2018[/TD]
[TD="align: right"]1,1993[/TD]
[TD]$358.718,75[/TD]
[TD="align: right"]299.106,77 €[/TD]
[TD="align: right"]-299.106,77 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]K8554216[/TD]
[TD]APOM[/TD]
[TD]final payment_ESN 848462[/TD]
[TD="align: right"]02/02/2018[/TD]
[TD="align: right"]1,2492[/TD]
[TD]$ 2.600,60[/TD]
[TD="align: right"]2.081,82 €[/TD]
[TD="align: right"]-2.081,82 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD="align: right"]85426589[/TD]
[TD]APOM[/TD]
[TD]inspection[/TD]
[TD="align: right"]02/02/2018[/TD]
[TD="align: right"]1,2492[/TD]
[TD]$ 3.461,33[/TD]
[TD="align: right"]2.770,84 €[/TD]
[TD="align: right"]-2.770,84 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD="align: right"]85426589[/TD]
[TD]UIJ[/TD]
[TD]opmen[/TD]
[TD="align: right"]02/02/2018[/TD]
[TD="align: right"]1,2492[/TD]
[TD]$ 18.988,94[/TD]
[TD="align: right"]15.200,88 €[/TD]
[TD="align: right"]-15.200,88 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



Sheet 2 (sales)

[TABLE="class: cms_table_cms_table, width: 1699"]
<tbody>[TR]
[TD]Type of invoice[/TD]
[TD]Invoice Number[/TD]
[TD]Supplier/Debitor[/TD]
[TD]Description[/TD]
[TD]Invoice Date[/TD]
[TD]FX rate[/TD]
[TD]USD Amount[/TD]
[TD]EUR Amount[/TD]
[TD]Change in Inventory[/TD]
[TD]Machinery[/TD]
[TD]Category[/TD]
[/TR]
[TR]
[TD]R[/TD]
[TD]AR00214522[/TD]
[TD]ADA[/TD]
[TD]AR00251452[/TD]
[TD="align: right"]11/04/2018[/TD]
[TD="align: right"]1,2384[/TD]
[TD]$ 15.222,00[/TD]
[TD="align: right"]€12.291,67[/TD]
[TD="align: right"]-12.291,67 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



sheet 3( purchase)

[TABLE="class: cms_table_cms_table, width: 1699"]
<tbody>[TR]
[TD]Type of invoice[/TD]
[TD]Invoice Number[/TD]
[TD]Supplier/Debitor[/TD]
[TD]Description[/TD]
[TD]Invoice Date[/TD]
[TD]FX rate[/TD]
[TD]USD Amount[/TD]
[TD]EUR Amount[/TD]
[TD]Change in Inventory[/TD]
[TD]Machinery[/TD]
[TD]Category[/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD="align: right"]58485[/TD]
[TD]AAD[/TD]
[TD]AP001523[/TD]
[TD="align: right"]11/04/2018[/TD]
[TD="align: right"]1,2384[/TD]
[TD]$ 15.222,00[/TD]
[TD="align: right"]€12.291,67[/TD]
[TD="align: right"]12.291,67 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD="align: right"]584885[/TD]
[TD]AAR[/TD]
[TD]AP001524[/TD]
[TD="align: right"]01/04/2018[/TD]
[TD="align: right"]1,2321[/TD]
[TD]$ 1.600,00[/TD]
[TD="align: right"]€1.298,60[/TD]
[TD="align: right"]1.298,60 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD="align: right"]584882[/TD]
[TD]AAE[/TD]
[TD]AP001525[/TD]
[TD="align: right"]01/04/2018[/TD]
[TD="align: right"]1,2321[/TD]
[TD]$ 500,00[/TD]
[TD="align: right"]€405,81[/TD]
[TD="align: right"]405,81 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD="align: right"]48595[/TD]
[TD]AES[/TD]
[TD]AP001526[/TD]
[TD="align: right"]01/04/2018[/TD]
[TD="align: right"]1,2321[/TD]
[TD]$ 18.455,00[/TD]
[TD="align: right"]€14.978,49[/TD]
[TD="align: right"]14.978,49 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD="align: right"]485953[/TD]
[TD]AHJ[/TD]
[TD]AP001527[/TD]
[TD="align: right"]01/04/2018[/TD]
[TD="align: right"]1,2321[/TD]
[TD]$ 16.746,00[/TD]
[TD="align: right"]€13.591,43[/TD]
[TD="align: right"]13.591,43 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD="align: right"]1007019[/TD]
[TD]UIJ[/TD]
[TD]AP001528[/TD]
[TD="align: right"]01/04/2018[/TD]
[TD="align: right"]1,2321[/TD]
[TD]$ 6.200,00[/TD]
[TD="align: right"]€5.050,51[/TD]
[TD="align: right"]5.050,51 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD="align: right"]1007020[/TD]
[TD]JIMK[/TD]
[TD]AP001529[/TD]
[TD="align: right"]01/04/2018[/TD]
[TD="align: right"]1,2321[/TD]
[TD]$ 35.000,00[/TD]
[TD="align: right"]€28.434,48[/TD]
[TD="align: right"]28.434,48 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD="align: right"]8958952[/TD]
[TD]KYT[/TD]
[TD]AP001530[/TD]
[TD="align: right"]01/04/2018[/TD]
[TD="align: right"]1,2321[/TD]
[TD]$2.000.000,00[/TD]
[TD="align: right"]€1.617.992,07[/TD]
[TD="align: right"]1.617.992,07 €[/TD]
[TD="align: right"]1[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



I would like to have them transfer to a new sheet named overview Machine 1 (drop down list or pivot table)

And when I run the code, only column A were able to combine, all the other columns are left blank.

Could you please help me with this code and to get the job done?

Thank you in advance.
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Status
Not open for further replies.

Forum statistics

Threads
1,223,758
Messages
6,174,334
Members
452,555
Latest member
colc007

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top