Copy Range from specific sheet of all workbooks in a folder to a template and create new template in the Master sheet

JoeThomas

New Member
Joined
Aug 30, 2019
Messages
6
Greetings! I am quite new to this forum and know very little about VBA. Seeking your expertise in a matter that I've been searching for a couple of days to no avail. I am looking for a vba code to copy a Range from a sheet named "Estimation" of multiple workbooks in a folder to a template and the template needs to be duplicated every time for a different workbook. There are many threads for appending data to the same sheet. In my case I need the template to be duplicated in the same Master workbook and then the ranges to be copied from the other workbooks to the new template. If possible, the new template could be renamed to the actual workbooks name or atleast a part of the workbooks name.
The range from Estimation to be copied to the newly created template.
The ranges I need to be copied and pasted is from Sheet named "Estimation" to the Template.
"Q13:R112" to "Q13:R104" & "S13:T104" to "U13:V104"
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,974
Office Version
  1. 2013
Platform
  1. Windows
This assumes that
1. the template workbook will be in the same folder as all the other workbooks and
2, the code will be run from the template workbook
3. the template workbook will be open, and
4. the template sheet will be the active sheet.
Code:
Sub t()
Dim sh As Worksheet, ws As Worksheet, wb As Workbook, fPath As String, fName As String
Set sh = ActiveSheet
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xl*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            On Error Resume Next
                wb.Sheets("Estimation").Range("Q13:R112").Copy
                If Err.Number = 0 Then
                    sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    ActiveSheet.Range("Q13").PasteSpecial xlPasteValuesAndNumberFormats
                    wb.Sheets("Estimation").Range("S13:R104").Copy ActiveSheet.Range("U13")
                End If
                On Error GoTo 0
                Err.Clear
                wb.Close False
        End If
        fName = Dir
    Loop
    Beep
    MsgBox "All Sheets have been processed.", vbInformation, "PRCESSING COMPLETE"
End Sub
 

JoeThomas

New Member
Joined
Aug 30, 2019
Messages
6
@JLGWhiz - That's splendid! thank you very much... for being so prompt and it does exactly what I want it to do. I'm very grateful! God Bless!!!
 

JoeThomas

New Member
Joined
Aug 30, 2019
Messages
6
@JLGWhilz - Just out of Curiosity, is there anyway we can also rename the sheets with the name of the files. Maybe with a string function to accommodate the character length.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,974
Office Version
  1. 2013
Platform
  1. Windows
See if this works

Code:
Sub t2()
Dim sh As Worksheet, ws As Worksheet, wb As Workbook, fPath As String, fName As String
Set sh = ActiveSheet
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xl*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            On Error Resume Next
                wb.Sheets("Estimation").Range("Q13:R112").Copy
                If Err.Number = 0 Then
                    sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    ActiveSheet.Range("Q13").PasteSpecial xlPasteValuesAndNumberFormats
                    wb.Sheets("Estimation").Range("S13:R104").Copy ActiveSheet.Range("U13")
                    ActiveSheet.Name = Left(fName, InStr(fName, ".") - 1)
                End If
                On Error GoTo 0
                Err.Clear
                wb.Close False
        End If
        fName = Dir
    Loop
    Beep
    MsgBox "All Sheets have been processed.", vbInformation, "PRCESSING COMPLETE"
End Sub
 

JoeThomas

New Member
Joined
Aug 30, 2019
Messages
6
@JLGWhiz Thank you for your support, it doesn't work though. I tried several times to no avail. Would it be because of an update link prompt that it gives everytime I run the macro? it still does not copy the workbook names to the worksheets. It shows as Template (2), Template (3) and so on.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,160
Messages
5,594,597
Members
413,916
Latest member
Islandlady

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
Top