VBA - Consolidate Data and place the new data at the end of the main sheet

[LocalNeko]

Hello All,

I'm new in the macro space and I'm pretty sure this question has been asked before. But I have multiple worksheets (12 in total). That need to all be gathered in a single sheet. Now, I'm able to consolidate the files it's just that my problem is that the placing of each sheet is based on the for each loop that I'm using.

 For Each sh In ActiveWorkbook.Sheets(Array("Main Sheet", "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10","Sheet11","Sheet12"))

Code I'm Using:

Option Explicit


'Common Functions required for all routines:


Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(what:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function




Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(what:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

Sub CopyDataWithoutHeaders()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim StartRow As Long
    Dim ActWorksheet As Worksheet


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


     
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("MainSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
 
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "MainSheet"
    ActiveWindow.FreezePanes = False
    Range("B3").Select
    ActiveWindow.FreezePanes = True
    
    
     For Each sh In ActiveWorkbook.Sheets(Array("Main Sheet", "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10","Sheet11","Sheet12"))
    
     
        If IsError(Application.Match(sh.Name, _
                                     Array(DestSh.Name, "Information"), 0)) Then


            
            Last = LastRow(DestSh)
            shLast = LastRow(sh)


            
            If shLast > 0 And shLast >= StartRow Then


               
                Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))


                 
                If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                    MsgBox "There are not enough rows in the Destsh"
                    GoTo ExitTheSub
                End If


                 
                CopyRng.Copy
                With DestSh.Cells(Last + 1, "A")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                    ActiveSheet.Paste
                    Application.CutCopyMode = False
                End With


            End If


        End If
    Next



ExitTheSub:


    Application.GoTo DestSh.Cells(1)




    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox "AA froms copied" & vbNewLine & "RDBMergeSheet Updated"
End Sub

I need it so that the last edited row in a specific sheet is at the very bottom of the main sheet. Not based on the for each loop array.

I might be over complicating things. A "submit macro" for each sheet whenever they update and want the data to go to the main sheet is also fine. Or a "match macro" where if the data from the main sheet compared to a specific sheet doesn't match it'll copy the non match data at the end of the main sheet.
I just need for the latest data in each sheet to end up at the end of the main sheet.


I hope I'm making sense, also sorry if there are mistakes as this is my first post. I'm at my wits end so all help is appreciated.


Thank you.

 

[Rijnsent]

Hi LocalNeko,
your question makes sense. In VBA you could e.g. do something like this:

Set DestSh = Worksheets("MainSheet")
PasteRw = 3
For Each Sh In ActiveWorkbook.Sheets
    If Left(Sh.Name, 5) = "Sheet" Then
        Set Rng = Sh.UsedRange
        NrRws = Rng.Rows.Count
        Rng.EntireRow.Copy
        DestSh.Cells(PasteRw, "A").PasteSpecial xlPasteValues
        DestSh.Cells(PasteRw, "A").PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        PasteRw = PasteRw + NrRws
    End If
Next Sh
LastRow = DestSh.Range("A1").End(xlDown).Row
'or
LastRow = DestSh.Cells(DestSh.Rows.Count, "A").End(xlUp).Row

I haven't tested this code, but I hope you get the idea. Does that help?
Cheers,
Koen
P.S. hope your Cardboard Box is in a warm & dry place

 

[LocalNeko]

Hello Rijnsent.

I got it sorted out here, but thanks for answering! I'll test it out tomorrow and see if it's better than what I'm using now.

Again thanks for the help