Merging Worksheets with VBA

A

Andrada_Kio

New Member
Joined
Oct 24, 2018
Messages
8
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:

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!!!
 
Last edited by a moderator:
Sort by date Sort by votes
Hi Fluff,

Thank you very much for your response . I don't know if you saw my response at your comment but your macro works perfectly for the first sheet :smile:. Can you help me with the rest of 2 sheet? :smile:

Thank you again!
Andrada
 
Upvote 0

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Try
Code: 
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
   With Sheets("DataBase JDI")
      Lr = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      ary = Array("A:A", 1, "CN:CN", 2, "E:E", 3, "G:G", 4, "AP:AP", 5, "FP:FP", 6, "CO:CO", 7, "BB:BC", 8, "F:F", 10, "BD:BD", 12, "DF:DF", 13, "CL:CL", 14, "AR:AR", 15)
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:FP1").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
   With Sheets("DataBase SJ")
      Lr = ws.Range("B" & Rows.Count).End(xlUp).Offset(1).Row
      ary = Array("A:B", 0, "AA:AA", 2, "AG:AG", 3, "L:L", 4, "D:D", 6, "I:I", 7, "K:K", 8, "AG:AG", 13, "AF:AF", 15)
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:AG1").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
   Application.CutCopyMode = False
End Sub
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
358
Peter_SSs
Peter_SSs
M
  • Question Question
Operational Risk Methodology on VBA
Replies
0
Views
81
Mazurofgod
M
I
  • Question Question
Advice to move/edit array from module to worksheet
Replies
6
Views
224
ipbr21054
I
K
  • Question Question
How to shorten vba code without any problems
Replies
1
Views
279
kamranyd
K
M
  • Solved
vba to sum up each column for each employee on column (A)
Replies
6
Views
313
kvsrinivasamurthy
K

Forum statistics

Threads
1,223,896
Messages
6,175,260
Members
452,627
Latest member
KitkatToby

Share this page

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