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 :). Can you help me with the rest of 2 sheet? :)

Thank you again!
Andrada
 
Upvote 0

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
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

C
  • Question
This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?
4 5 6
Replies
50
Views
1K
Trebor76
T
J
  • Solved
VBA for adding formulas to specific Columns when a new row is added.
Replies
7
Views
238
dreid1011
dreid1011
E
  • Solved
Summing Values
Replies
3
Views
247
LazyBug
LazyBug
L
  • Solved
Input multiple ID and QTY in Excel VBA userform
Replies
7
Views
315
Legacy 143009
L
E
  • Question
Estimating Spreadsheet-Summing
Replies
1
Views
166
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,594
Messages
6,125,723
Members
449,255
Latest member
whatdoido

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