MACRO / VBA Copying specific ranges/cells on a standard template

[Paulo_Araujo]

Hello there. Good afternoon.


I fairly new to VBA, I use it to work on simple macros to automate my time.


I asked for help on Stack Overflow, but unfortunately, i could not get the answer I need. The code the friend provided didn't work. (Link)


I am looking for an Excel macro which copies specific cells, on different regions of a series of worksheets from the same template.
All sheets work on the same workbook and need to be this way.
The main quest is, consolidate it i on worksheet.


How I need it? I can have 2 ways of answer, Option 1: summarize each sheet in one row, copying the cells I need side by side, with just the same headers and put a total sum in the end of the columns.
(See

)


Or Option 2: Keep the template I made and sum the values from the sheets created on the same spaces used.
(See

)




If it's simpler to keep/use the template and sum the values in there, ok for me too.


I need it to be "refreshable". If I've created 20 new sheets, the macro will read the already existed (Exlcuding the ons listed) and the new sheets and consolidate it in the sheet "consolidated".


I've found a code that do almost everything I need, but I'm struggling to change de range/area to copy regions i want. Source.


Like i said, using the template (create a copy from the master template and summing the values in there) or simply combining the value side by side, so every row represent a sheet, is ok for me ok too.


Please, any help is welcomed, thanks in advance.


The code I used follows below and the link to blank file is here.


===============================


Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range


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


'Delete the sheet "Consolidado" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Consolidado").Delete
On Error GoTo 0
Application.DisplayAlerts = True


'Add a worksheet with the name "Consolidado"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Consolidado"


'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name And sh.Name <> "Menu" And sh.Name <> "Infos" And sh.Name <> "Log Update" And sh.Name <> "Master" Then


'Find the last row with data on the DestSh
Last = LastRow(DestSh)




'Fill in the range that you want to copy
Set CopyRng = sh.Range("A1").CurrentRegion






'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If


'This example copies values/formats, if you only want to copy the
'values or want to copy everything look at the example below this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next


ExitTheSub:


Application.Goto DestSh.Cells(1)


'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


===============================