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

LocalNeko

New Member
Joined
Oct 22, 2019
Messages
8
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.
PHP:
 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:
Code:
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

Code:
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.
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Hi LocalNeko,
your question makes sense. In VBA you could e.g. do something like this:
Code:
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 ;)
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,495
Messages
6,113,992
Members
448,538
Latest member
alex78

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