Copy Data from worksheet to another one with VBA

[nelsonlauo]

Hello all,

I would like to copy data from Tables 1 to 4 (Data) and pastes to the specific columns in another worksheet (Expected Result).

Table 1 NO_ISSUED: from row 1 to 99 (from column A)
Table 2 ISSUE_DATE: from row 100 to 199 (from column B)
Table 3 NET_LIST_SA: from row 200 to 299 (from column B)
Table 4 PRICE_DIFF_PERCENT: from row 300 to 399 (from column B)

Sorry that I am new in VBA and knew that I should use array function to do so, but still can't find success.

Have attached sample Excel with dummy data. Thanks for your advice.

[SamT]

Your sample Excel does not match your description.

[nelsonlauo]

Attached is my latest working file. I just tried to copy table 1 data first, and then table 2, table 3..

[SamT]

Now edit your post #1 to accurately describe the workbook and what you need.

Note that in your workbook, column B in Data is empty, and column A is just a descending count from 24 to 1 in all tables.

[nelsonlauo]

Sorry that I can't see the Edit function. Attached is my revised VBA code. I would like to loops through all columns in multiple worksheets (Data1 - Data4) and creates the consolidated table. How can I revise the code from looping further every 4 columns and look likes worksheet "Expected Result"?


Sub TestMacro() Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Dim path As String, fileName As String
Dim lastRowInput As Long, lastRowOutput As Long, rowCntr As Long, lastColumn As Long
Dim inputWS1 As Worksheet, inputWS2 As Worksheet, inputWS3 As Worksheet, inputWS4 As Worksheet, outputWS As Worksheet


'set your sheets here
Set inputWS1 = ThisWorkbook.Sheets("Data1")
Set inputWS2 = ThisWorkbook.Sheets("Data2")
Set inputWS3 = ThisWorkbook.Sheets("Data3")
Set inputWS4 = ThisWorkbook.Sheets("Data4")
Set outputWS = ThisWorkbook.Sheets("Test")
rowCntr = 1


'get last rows from both sheets
lastRowInput = inputWS1.Cells(Rows.Count, "A").End(xlUp).row
lastRowOutput = outputWS.Cells(Rows.Count, "A").End(xlUp).row
lastColumn = inputWS1.Cells(1, Columns.Count).End(xlToLeft).Column


'copy data from columns
inputWS1.Range("A1:B" & lastRowInput).Copy outputWS.Range("A" & lastRowOutput + 1)

inputWS1.Range("C1:C" & lastRowInput).Copy outputWS.Range("F" & lastRowOutput + 1)
inputWS1.Range("D1:D" & lastRowInput).Copy outputWS.Range("J" & lastRowOutput + 1)
inputWS1.Range("E1:E" & lastRowInput).Copy outputWS.Range("N" & lastRowOutput + 1)


inputWS2.Range("B1:B" & lastRowInput).Copy outputWS.Range("C" & lastRowOutput + 1)
inputWS2.Range("C1:C" & lastRowInput).Copy outputWS.Range("G" & lastRowOutput + 1)
inputWS2.Range("D1:D" & lastRowInput).Copy outputWS.Range("K" & lastRowOutput + 1)
inputWS2.Range("E1:E" & lastRowInput).Copy outputWS.Range("O" & lastRowOutput + 1)

inputWS3.Range("B1:B" & lastRowInput).Copy outputWS.Range("D" & lastRowOutput + 1)
inputWS3.Range("C1:C" & lastRowInput).Copy outputWS.Range("H" & lastRowOutput + 1)
inputWS3.Range("D1:D" & lastRowInput).Copy outputWS.Range("L" & lastRowOutput + 1)
inputWS3.Range("E1:E" & lastRowInput).Copy outputWS.Range("P" & lastRowOutput + 1)

inputWS4.Range("B1:B" & lastRowInput).Copy outputWS.Range("E" & lastRowOutput + 1)
inputWS4.Range("C1:C" & lastRowInput).Copy outputWS.Range("I" & lastRowOutput + 1)
inputWS4.Range("D1:D" & lastRowInput).Copy outputWS.Range("M" & lastRowOutput + 1)
inputWS4.Range("E1:E" & lastRowInput).Copy outputWS.Range("Q" & lastRowOutput + 1)

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

[SamT]

That is some good looking code

You have marked the thread "Solved". Do you need anything else?

[nelsonlauo]

Thanks, Sam. The problem is solved.