VBA: copying and renaming template files based on data

[MrWisco99]

Hello,

I'm looking for some help! I have several rows of data with the following sample information:

[TABLE="width: 100"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Item Decription[/TD]
[TD]Units[/TD]
[TD]Prop. Line[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Removing Asphaltic Surface[/TD]
[TD]SY[/TD]
[TD]0004[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Removing Guardrail[/TD]
[TD]LF[/TD]
[TD]0014[/TD]
[/TR]
</tbody>[/TABLE]

I also have a "Templates" folder with template excel files named after the different units (i.e., SY, LF, etc.). For each row of data I have to look up the "Unit" in column B, then find the template file with the same "Unit" name, then copy and rename the template file to a destination folder. I need to rename the copied template file using the information in column C and A as follows: "Prop. Line_Item Description".

So for Row 2 in the table above, I would copy the "SY.xlsx" template file and rename it in a destination folder as "0004_Removing Asphaltic Surface.xlsx".

For Row 3 in the table above, I would copy the "LF.xlsx" template file and rename it as "0014_Removing Guardrail.xlsx" in the same destination folder as Row 2.

I'm wondering if anyone would be able to help me automate this process! Thanks in advance!

 

[crazydragon84]

just posting an unnecessary comment here...

yes its possible, its like a 5 line code. but this is a questions forum not please do it for me forum. have you done research and tried to do this on your own?

 

[wideboydixon]

Alt+F11 to bring up the VBA window then Insert->Module from the menu. Paste the following into the code window:

Public Sub CopyTemplates()

Const templateFolder = "C:\Templates\" ' Set to the folder where the templates are
Const targetFolder = "C:\TargetFolder\" ' Set to the folder where the files are to be created

Dim lastRow As Long
Dim thisRow As Long
Dim sourceFile As String
Dim targetFile As String

lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For thisRow = 2 To lastRow
    sourceFile = templateFolder & Cells(thisRow, "B").Value & ".xlsx"
    targetFile = targetFolder & Cells(thisRow, "C").Value & "_" & Cells(thisRow, "A").Value & ".xlsx"
    If Dir$(sourceFile) <> "" And Dir$(targetFile) = "" Then FileCopy sourceFile, targetFile
Next thisRow

End Sub

Change the templateFolder and targetFolder locations as necessary - make sure to include the trailing slash. I think that should work but I haven't tested it.

WBD

 

[MrWisco99]

Appreciate the help WBD!! It worked perfect.

Would an additional code allow for cells A2, B2, and C2 of the table above to be copied and pasted into A1, A2, and A3, respectively for the first target file and so on for each row?

So for completing the "0004_Removing Asphaltic Surface.xlsx" target file,
cell A2 ("Removing Asphaltic Surface") would be pasted in A1 of the target file
cell B2 ("SY") would be pasted in A2 of the target file
cell C2 ("0004") would be pasted in A3 of the target file.

Then for completing the the next target file, "0014_Removing Guardrail.xlsx"
cell A3 ("Removing Guardrail") would be pasted in A1 of the target file
cell B3 ("LF") would be pasted in A2 of the target file
cell C3 ("0014") would be pasted in A3 of the target file.

 

[wideboydixon]

A bit trickier because you have to open the copied workbook but give this a try:

Public Sub CopyTemplates()

Const templateFolder = "C:\Sandbox\MrExcel\Templates\" ' Set to the folder where the templates are
Const targetFolder = "C:\Sandbox\MrExcel\TargetFolder\" ' Set to the folder where the files are to be created

Dim lastRow As Long
Dim thisRow As Long
Dim sourceFile As String
Dim targetFile As String
Dim sourceSheet As Worksheet
Dim sourceBook As Workbook
Dim targetBook As Workbook

Application.ScreenUpdating = False

Set sourceBook = ActiveWorkbook
Set sourceSheet = ActiveSheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
For thisRow = 2 To lastRow
    sourceFile = templateFolder & sourceSheet.Cells(thisRow, "B").Value & ".xlsx"
    targetFile = targetFolder & sourceSheet.Cells(thisRow, "C").Value & "_" & sourceSheet.Cells(thisRow, "A").Value & ".xlsx"
    If Dir$(sourceFile) <> "" And Dir$(targetFile) = "" Then
        FileCopy sourceFile, targetFile
        Set targetBook = Workbooks.Open(targetFile)
        targetBook.Sheets(1).Range("A1").Value = sourceSheet.Cells(thisRow, "A").Value
        targetBook.Sheets(1).Range("A2").Value = sourceSheet.Cells(thisRow, "B").Value
        targetBook.Sheets(1).Range("A3").Value = sourceSheet.Cells(thisRow, "C").Value
        targetBook.Save
        targetBook.Close
    End If
Next thisRow

Application.ScreenUpdating = True

End Sub

WBD

 

[MrWisco99]

WBD, you're a lifesaver. Appreciate all the help! I have a separate code for renaming sheets I can now throw into yours to make one "master" code. Thanks again!!