MAcro for Multiple Sheets with defined names

[lbanham]

Good morning,

I need a macro to combine multiple sheets into one combined sheet.
I need it to only combine the Tabs that have "Debit Balance" in the name and move it into a sheet called "Debit Balance Summary"
I am using Excel 2003.
The active rows varies on all sheets but the columns remain static at A to L.

Any suggestions are appreciated.

Thank you

Lynsey

 

[Sektor]

Try this.

[COLOR="Blue"]Sub[/COLOR] DebitBalanceSummary()

    [COLOR="Blue"]Dim[/COLOR] lastRow [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Long[/COLOR]
    [COLOR="Blue"]Dim[/COLOR] lastRowA [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Long[/COLOR], lastRowL [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Long[/COLOR]
    [COLOR="Blue"]Dim[/COLOR] wksTarget [COLOR="Blue"]As[/COLOR] Worksheet
    [COLOR="Blue"]Dim[/COLOR] sh [COLOR="Blue"]As[/COLOR] Worksheet
    [COLOR="Blue"]Dim[/COLOR] rngLastA [COLOR="Blue"]As[/COLOR] Range, rngLastL [COLOR="Blue"]As[/COLOR] Range
    
    [COLOR="Blue"]Set[/COLOR] wksTarget = Worksheets("Debit Balance Summary")
    
    [COLOR="Blue"]For[/COLOR] [COLOR="Blue"]Each[/COLOR] sh [COLOR="Blue"]In[/COLOR] Sheets
        [COLOR="Blue"]If[/COLOR] sh.Name = "Debit Balance" [COLOR="Blue"]Then[/COLOR]
            [COLOR="Blue"]With[/COLOR] sh
                lastRowA = .Range(Rows.Count, "A").End(xlUp).Row
                lastRowL = .Range(Rows.Count, "L").End(xlUp).Row
                [COLOR="Blue"]Set[/COLOR] rngLast = wksTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Range("A1:A" & lastRowA).Copy
                rngLast.PasteSpecial xlPasteValues
                .Range("A1:A" & lastRowA).Copy
                rngLast.Offset(0, 11).PasteSpecial xlPasteValues
            [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]With[/COLOR]
        [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
    [COLOR="Blue"]Next[/COLOR]

    wksTarget.Rows(1).Delete
    
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]

 

[Trevor G]

Good morning,

I need a macro to combine multiple sheets into one combined sheet.
I need it to only combine the Tabs that have "Debit Balance" in the name and move it into a sheet called "Debit Balance Summary"
I am using Excel 2003.
The active rows varies on all sheets but the columns remain static at A to L.

Any suggestions are appreciated.

Thank you

Lynsey

Try this as an alternative

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> debit1()<br><SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> wsSummary <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Set</SPAN> wsSummary = Worksheets("Debit Balance Summary")<br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ws <SPAN style="color:#00007F">In</SPAN> Sheets<br><SPAN style="color:#00007F">If</SPAN> ws.Name <SPAN style="color:#00007F">Like</SPAN> "*Debit Balance*" <SPAN style="color:#00007F">Then</SPAN><br><SPAN style="color:#00007F">With</SPAN> ws<br>.UsedRange.Copy<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>wsSummary.Activate<br>Range("A1").Select<br><SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">Until</SPAN> ActiveCell.Value = ""<br>ActiveCell.Offset(1, 0).Select<br><SPAN style="color:#00007F">Loop</SPAN><br>ActiveCell.PasteSpecial xlPasteAll<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">Next</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[lbanham]

Try this as an alternative

Thanks Trevor. This works great. Would it be possible to amend so that it finishes by sorting by column b, then deleting any rows that have "Total" in column b?

Thanks again

Lynsey

 

[Trevor G]

Are you wanting to sort on Each Debit Balance Sheet or the Summary Sheet?

Are you looking for cell contents that has Total as text?

Could you show some sample data to help here please.

 

[lbanham]

Yes. I need to sort it on the Summary sheet and Total is text.
Also I need it to ignore row 1 in each of the individual sheets as this is just column names that it is copying in.

I have tried to copy an example in below, hopefully it worked.

Brand ACC NO COMMERCIAL DOMESTIC INV DATE Acc BAL VAT RATE NET AMOUNT VAT AMOUNT WRITE OFF GROSS AMOUNT DEPOT COMMENTS
Brand 1234560 Lynsey 14.12.10 6,388.17 1.000 5,000.32 1,387.85 6,388.17 Scotlans
Brand 1.000 0.00 0.00 0.00
Brand 1.000 0.00 0.00 0.00
Brand 1.000 0.00 0.00 0.00
Brand 1.000 0.00 0.00 0.00
Brand 1.000 0.00 0.00 0.00
Brand 1.000 0.00 0.00 0.00
Brand 1.000 0.00 0.00 0.00
Brand TOTAL 6,388.17 5,000.32 1,387.85 6,388.17
Brand


Thanks!

 

[Trevor G]

Try this as a complete solution then Lynsey

Sub debit1()
Dim ws As Worksheet
Dim rng As Range
Dim wsSummary As Worksheet
Set wsSummary = Worksheets("Debit Balance Summary")
For Each ws In Sheets
If ws.Name Like "*Debit Balance*" Then
With ws
Set rng = Range("a1").CurrentRegion
Set rng = rng.Offset(1, 0)
Set rng = rng.Resize(rng.Rows.Count - 1)
rng.Copy
End With
wsSummary.Activate
Range("A1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.PasteSpecial xlPasteAll
End If
Next
Application.CutCopyMode = False
Sheets("Debit Balance Summary").Range("B2:B500").Sort Key1:=Sheets("Debit Balance Summary").Range("B2:B500"), Order1:=xlAscending
Sheets("Debit Balance Summary").Activate

Range("B2").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "Total" Then
ActiveCell.EntireRow.Delete
End If
Loop


End Sub

 

[lbanham]

Thanks Trevor. All working now.

Appreciate the help.

Lynsey

 

[Trevor G]

Pleased to read you have a working solution.