Merging Worksheets with VBA

[Andrada_Kio]

Hi,
I have a VBA code to merging worksheets (I need only some columns) , but it works very slowly , 45 min to run the macro.
Can someone tell me if the macro can be changed to work faster. Bellow the code :

Thank you!!

Code:

[COLOR=#333333]Sub ConsolidateTable()[/COLOR]

[COLOR=#333333]For i = 2 To Sheets("DataBase JDE").Range("A1048576").End(xlUp).Row[/COLOR]

[COLOR=#333333]If Not IsEmpty(Sheets("DataBase JDE").Range("A" & i)) Then[/COLOR]

[COLOR=#333333]Sheets("DataBase Total").Range("A" & Sheets("DataBase Total").Range("A1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("A" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("B" & Sheets("DataBase Total").Range("B1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("B" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("C" & Sheets("DataBase Total").Range("C1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("AA" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("D" & Sheets("DataBase Total").Range("D1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("C" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("E" & Sheets("DataBase Total").Range("E1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("E" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("F" & Sheets("DataBase Total").Range("F1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("F" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("G" & Sheets("DataBase Total").Range("G1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("Q" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("H" & Sheets("DataBase Total").Range("H1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("R" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("I" & Sheets("DataBase Total").Range("I1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("S" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("J" & Sheets("DataBase Total").Range("J1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("U" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("K" & Sheets("DataBase Total").Range("K1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("AB" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("L" & Sheets("DataBase Total").Range("L1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("BE" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("M" & Sheets("DataBase Total").Range("M1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("P" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("N" & Sheets("DataBase Total").Range("N1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("BC" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("O" & Sheets("DataBase Total").Range("O1048576").End(xlUp).Row + 1) = Sheets("DataBase JDE").Range("BD" & i)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("P" & Sheets("DataBase Total").Range("P1048576").End(xlUp).Row + 1) = " "[/COLOR]

[COLOR=#333333]End If[/COLOR]

[COLOR=#333333]Next i[/COLOR]

[COLOR=#333333]For J = 2 To Sheets("DataBase JDI").Range("A1048576").End(xlUp).Row[/COLOR]

[COLOR=#333333]If Not IsEmpty(Sheets("DataBase JDI").Range("A" & J)) Then[/COLOR]

[COLOR=#333333]Sheets("DataBase Total").Range("A" & Sheets("DataBase Total").Range("A1048576").End(xlUp).Row + 1) = " "[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("B" & Sheets("DataBase Total").Range("B1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("A" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("C" & Sheets("DataBase Total").Range("C1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("CN" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("D" & Sheets("DataBase Total").Range("D1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("E" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("E" & Sheets("DataBase Total").Range("E1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("G" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("F" & Sheets("DataBase Total").Range("F1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("AP" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("G" & Sheets("DataBase Total").Range("G1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("FP" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("H" & Sheets("DataBase Total").Range("H1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("CO" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("I" & Sheets("DataBase Total").Range("I1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("BB" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("J" & Sheets("DataBase Total").Range("J1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("BC" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("K" & Sheets("DataBase Total").Range("K1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("F" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("L" & Sheets("DataBase Total").Range("L1048576").End(xlUp).Row + 1) = " "[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("M" & Sheets("DataBase Total").Range("M1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("BD" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("N" & Sheets("DataBase Total").Range("N1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("DF" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("O" & Sheets("DataBase Total").Range("O1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("CL" & J)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("P" & Sheets("DataBase Total").Range("P1048576").End(xlUp).Row + 1) = Sheets("DataBase JDI").Range("AR" & J)[/COLOR]

[COLOR=#333333]End If[/COLOR]

[COLOR=#333333]Next J[/COLOR]

[COLOR=#333333]For k = 2 To Sheets("DataBase SJ").Range("A1048576").End(xlUp).Row[/COLOR]

[COLOR=#333333]If Not IsEmpty(Sheets("DataBase SJ").Range("A" & k)) Then[/COLOR]

[COLOR=#333333]Sheets("DataBase Total").Range("A" & Sheets("DataBase Total").Range("A1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("A" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("B" & Sheets("DataBase Total").Range("B1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("B" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("C" & Sheets("DataBase Total").Range("C1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("AA" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("D" & Sheets("DataBase Total").Range("D1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("AG" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("E" & Sheets("DataBase Total").Range("E1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("L" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("F" & Sheets("DataBase Total").Range("F1048576").End(xlUp).Row + 1) = " "[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("G" & Sheets("DataBase Total").Range("G1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("D" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("H" & Sheets("DataBase Total").Range("H1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("I" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("I" & Sheets("DataBase Total").Range("I1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("K" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("J" & Sheets("DataBase Total").Range("J1048576").End(xlUp).Row + 1) = " "[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("K" & Sheets("DataBase Total").Range("K1048576").End(xlUp).Row + 1) = " "[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("L" & Sheets("DataBase Total").Range("L1048576").End(xlUp).Row + 1) = " "[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("M" & Sheets("DataBase Total").Range("M1048576").End(xlUp).Row + 1) = " "[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("N" & Sheets("DataBase Total").Range("N1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("AG" & k)[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("O" & Sheets("DataBase Total").Range("O1048576").End(xlUp).Row + 1) = " "[/COLOR]
[COLOR=#333333]Sheets("DataBase Total").Range("P" & Sheets("DataBase Total").Range("P1048576").End(xlUp).Row + 1) = Sheets("DataBase SJ").Range("AF" & k)[/COLOR]

[COLOR=#333333]End If[/COLOR]

[COLOR=#333333]Next k[/COLOR]

[COLOR=#333333]End Sub[/COLOR]

Thank you!!!

 

[ravishankar]

Why it calculates the last row for every column every time? is it a variable number? Can you upload a link to your file so that we can try to make it faster.
ravi shankar

 

[Joe4]

Welcome to the Board!

Instead of of going through row-by-row, you should be able to copy and paste whole columns at a time. That will eliminate the need for loops.

Also, add these lines at the very beginning of your code:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

This will disable screen updating and calculations until you have finished running through your code.

Then make sure to add this at the end of your code to turn them back on:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

This trick will help speed up any code.

 

[Andrada_Kio]

Hi Ravi,

Thank you for your reply. I'm new in the VBA "process" and was the first VBA created be me... below is the link with the file. Thank again for helping me


[url]https://www.transfernow.net/2805f9z1wq2y[/URL]

Andrada

 

[Andrada_Kio]

Hi Joe,

I already try with this code at the begging of the code but did't help very much... maybe 3 min...but this code run for almost 1 hour....

 

[Joe4]

I already try with this code at the begging of the code but did't help very much... maybe 3 min...but this code run for almost 1 hour....

You are going to get the biggest "bang for the buck" by doing the other thing I told you:

Instead of of going through row-by-row, you should be able to copy and paste whole columns at a time. That will eliminate the need for loops.

Loops are notoriously inefficient and can kill performance if you are going through hundreds of thousands of records.
Whenever they can be avoided, they should be. And it should be pretty easy to do so here. You can identify the last line of data, and then copy that column down to that row, and paste it to the other sheet.

Since your columns don't match up exactly (copying column A,B,C and then pasting to columns A,B,C), you may need to do each column individually, but that will still be hundreds of times faster than going through row-by-row.

 

[Fluff]

Does this work for the first sheet

Sub ConsolidateTable()
   Dim Ary As Variant
   Dim i As Long, Lr As Long
   Dim Ws As Worksheet
   
   Application.ScreenUpdating = False
   Set Ws = Sheets("DataBase Total")
   With Sheets("DataBase JDE")
      Lr = Ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      Ary = Array("A:B", 0, "AA:AA", 2, "C:C", 3, "E:F", 4, "Q:S", 6, "U:U", 9, "AB:AB", 10, "BE:Be", 11, "P:P", 12, "BC:BD", 13)
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:BE1").AutoFilter 1, "<>"
      For i = 0 To UBound(Ary) Step 2
         Intersect(.AutoFilter.Range.Offset(1), .Range(Ary(i))).Copy
         Ws.Range("A" & Lr).Offset(, Ary(i + 1)).PasteSpecial xlPasteValues
      Next i
      .AutoFilterMode = False
   End With
End Sub

 

[Andrada_Kio]

Hi Fluff,

Yes, perfectly!

Andrada

 

[Fluff]

Ok, can you adapt that for the other two sheets?

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...sheets-but-only-some-columns.html#post4997548

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.