Data combination - VBA requires modification

[Aberdham]

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:

Invoice type	Invoice Number	Supplier/Debitor	Description	Invoice Date	FX rate	USD Amount	EUR Amount	Change in Inventory	Machinery	Category
A	K8554214	ADA	Deposit SN 844451	01/12/2017	1,1885	$361.067,54	303.801,05 €	-303.801,05 €	1
A	K8554215	ADA	final payment_ESN 848462	01/01/2018	1,1993	$358.718,75	299.106,77 €	-299.106,77 €	1
A	K8554216	APOM	final payment_ESN 848462	02/02/2018	1,2492	$ 2.600,60	2.081,82 €	-2.081,82 €	1
A	85426589	APOM	inspection	02/02/2018	1,2492	$ 3.461,33	2.770,84 €	-2.770,84 €	1
A	85426589	UIJ	opmen	02/02/2018	1,2492	$ 18.988,94	15.200,88 €	-15.200,88 €	1

<tbody>
</tbody>

Sheet 2 (sales)

Type of invoice	Invoice Number	Supplier/Debitor	Description	Invoice Date	FX rate	USD Amount	EUR Amount	Change in Inventory	Machinery	Category
R	AR00214522	ADA	AR00251452	11/04/2018	1,2384	$ 15.222,00	€12.291,67	-12.291,67 €	1

<tbody>
</tbody>

sheet 3( purchase)

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

<tbody>
</tbody>

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.

 

[Fluff]

Duplicate https://www.mrexcel.com/forum/excel...e-extraction-data-vba-issues.html#post5060748

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).