Combine sheets using a specific list of sheet names

[SammyCRX]

Hi,

Really hoping somebody can help please, as I've been going round in circles with this for ages. I did have some better code than that below, but I deleted it and instantly regretted it (I was so close!). Anyway, here's what I'd like to do:

1) On 'Delete Sheets' I have a list of company names. Originally this sheet was for deleting sheets in bulk (which works fine), but I've been asked to add a button to combine the sheets using the same list. The list is in column A and I need the data from all the sheets named in this list to be moved to a new sheet called 'Not Reconciled'. If I could somehow prove all the data had combined successfully without loss of data then that would be even better

2) The list of names on 'Delete Sheets' doesn't update automatically... so it could be that sometimes these sheet names will not exist, depending on the data we receive. I got around this with my delete macro by putting in error handling to skip the sheet if it doesn't exist (there's no error handling in my code below, of course). I haven't tried to loop it either.

3) I need to use offset, so as not to delete the final row when adding data. But I've reached the point where I can't think my way through it anymore!

Hopefully that makes sense? In the example below I've used the sheet 'Gamma' as an example, but I need the sheet name to populate there for each name in the list and loop through.

I think what's confusing me the most is that the 'last row' on the 'Not Reconciled' sheet is dynamic, in that it's always updating after each addition. Does the macro automatically take this into account on each loop?

Any help would be much appreciated

Thanks,
Sam

Sub MergeSheets()'
' MergeSheets Macro
'


'
    'Adds sheet where the data needs to be moved to
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Not Reconciled"
    
    'Adds headers
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Item"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Dealer"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "SiteID"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "SiteName"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "CLI_Number"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Description"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "StdBillDescription"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Purchase"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Selling"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "KitFund"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "BillDate"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "BillFrom"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "BillTo"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "ProductType"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "CLIServiceID"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "ProductCodeID"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Refund"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "OneOff"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "FrequencyID"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "SupplierName"
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "SupplierProductCategory"
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "SupplierProductRef"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "CustomerPO"
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "NominalCode"
    Range("Y1").Select
    ActiveCell.FormulaR1C1 = "CategoryGroup"
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "Category"
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "CompletedBy"
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "Quantity"
    Range("AC1").Select
    ActiveCell.FormulaR1C1 = "Link"
    Range("AD1").Select
    ActiveCell.FormulaR1C1 = "TicketID"
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = "AdHoc"
    Range("AF1").Select
    ActiveCell.FormulaR1C1 = "CLIService"
    Range("AG1").Select
    ActiveCell.FormulaR1C1 = "ProductCode"
    Range("AH1").Select
    ActiveCell.FormulaR1C1 = "Frequency"
    Range("AH2").Select
    
    'Finds how many spreadsheets need to be merged
    Sheets("Delete Sheets").Select
    LastRowOnDeleteSheets = Columns("A").Find("*", , xlValues, , xlRows, xlPrevious).Row
    
    
    Sheets("Gamma").Select
    LastRowOnGammaSheet = Columns("A").Find("*", , xlValues, , xlRows, xlPrevious).Row
    Rows("1:" & LastRowOnGammaSheet).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Not Reconciled").Select
    LastRowOnNotReconciledSheet = Columns("A").Find("*", , xlValues, , xlRows, xlPrevious).Row
    
    'Need it to drop down one row here
    
    Rows(LastRowOnNotReconciledSheet & ":" & LastRowOnNotReconciledSheet).Select
    ActiveSheet.Paste
    
End Sub

 

[Fluff]

How about

Sub SammyCRX() '
   Dim Ws As Worksheet
   Dim Ary As Variant
   Dim i As Long
   
   Set Ws = Sheets.Add(, ActiveSheet)
   Ws.Name = "Not Reconciled"
   Ws.Range("A1:AH1").Value = Array("Item", "Dealer", "SiteID", "SiteName", "CLI_Number", "Description", "StdBillDescription" _
         , "Purchase", "Selling", "KitFund", "BillDate", "BillFrom", "BillTo", "ProductType", "CLIServiceID", "ProductCodeID" _
         , "Refund", "OneOff", "FrequencyID", "SupplierName", "SupplierProductCategory", "SupplierProductRef" _
         , "CustomerPO", "NominalCode", "CategoryGroup", "Category", "CompletedBy", "Quantity", "Link" _
         , "TicketID", "AdHoc", "CLIService", "ProductCode", "Frequency")
         
   With Sheets("Delete sheets")
      Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
   End With
   For i = 1 To UBound(Ary)
      If Evaluate("isref('" & Ary(i, 1) & "'!A1)") Then
         With Sheets(Ary(i, 1))
            .Range("A1").CurrentRegion.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         End With
      End If
   Next i
End Sub

 

[SammyCRX]

Hi,

Thanks for the reply and code. It seemed to be going nicely, but went into debug mode at the following line:

If Evaluate("isref('" & Ary(i, 1) & "'!A1)") Then

I honestly couldn't understand this section of code, so I don't know why it would be doing this. I suspect that it's where the list ends and it can't find the next sheet (it'll be a blank cell that it's searching for, therefore a blank sheet name)... could that be it? So could I maybe throw in a bit of basic error handling to say if it doesn't find the sheet name (blank cell in this case) just continue anyway?

Could I also please ask how it's pasting the data in? I usually use a paste command and it stands out a mile, but I couldn't figure it out... it'd be interesting to know which bit of code does that please The header rows are also pasting in from each sheet - that's my fault, as I didn't mention that I didn't need to include the top row from each sheet.

Thanks,
Sam

 

[Fluff]

Ok, how about

Sub SammyCRX()
   Dim Ws As Worksheet
   Dim Ary As Variant
   Dim i As Long
   
   Set Ws = Sheets.Add(, ActiveSheet)
   Ws.Name = "Not Reconciled"
   Ws.Range("A1:AH1").Value = Array("Item", "Dealer", "SiteID", "SiteName", "CLI_Number", "Description", "StdBillDescription" _
         , "Purchase", "Selling", "KitFund", "BillDate", "BillFrom", "BillTo", "ProductType", "CLIServiceID", "ProductCodeID" _
         , "Refund", "OneOff", "FrequencyID", "SupplierName", "SupplierProductCategory", "SupplierProductRef" _
         , "CustomerPO", "NominalCode", "CategoryGroup", "Category", "CompletedBy", "Quantity", "Link" _
         , "TicketID", "AdHoc", "CLIService", "ProductCode", "Frequency")
         
   With Sheets("Delete sheets")
      Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
   End With
   For i = 1 To UBound(Ary)
      If Ary(i, 1) <> Empty Then
         If Evaluate("isref('" & Ary(i, 1) & "'!A1)") Then
            With Sheets(Ary(i, 1))
              [COLOR=#0000ff] .Range("A1").CurrentRegion.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)[/COLOR]
            End With
         End If
      End If
   Next i
End Sub

And the line in blue is copying the data across

 

[SammyCRX]

Thank you, that worked perfectly

I really need to get better with macros! I understand some of that code, but there are a few bits I can't get my head around. One last question... at the moment it's copying in the header row from each sheet. Is it possible to stop this from happening? If I understand correctly, 'CurrentRegion' relates to a broad section of data from one corner to the other? In which case, would I need a bit of code to delete the header row from each sheet before copying? The sheets will be deleted afterwards anyway, so that wouldn't be a problem.

Thanks,
Sam

 

[Fluff]

Try

            With Sheets(Ary(i, 1))
               .Range("A1").CurrentRegion[COLOR=#ff0000].Offset(1)[/COLOR].Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
            End With

 

[SammyCRX]

Thanks, that's absolutely perfect! I've added some COUNTIF/INDIRECT formulas next to my list of sheets to reassure the user that everything has copied across okay. Thanks so much, I really appreciate your help

 

[Fluff]

You're welcome & thanks for the feedback