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

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
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

B
  • Question Question
VBA Compatibility Issues with Excel for Mac
Replies
1
Views
38
Dan_W
D
G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
389
Peter_SSs
Peter_SSs
J
  • Solved
Changing Worksheet Name to apply formulas based on cell reference entry
Replies
4
Views
34
Joe4
Joe4
M
  • Question Question
Operational Risk Methodology on VBA
Replies
0
Views
122
Mazurofgod
M
I
  • Question Question
Advice to move/edit array from module to worksheet
Replies
6
Views
234
ipbr21054
I

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

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