PDA

View Full Version : [SOLVED] In merged file, re-name sheets to include part of workbook name that they came from?



ajjava
06-05-2019, 01:55 PM
I have the following code that merges several Excel workbooks into one (new) destination workbook.
Each workbook to be merged contains several sheets. The sheets have identical names, across all of the workbooks to be merged.
SO, I'd like the macro to give the merged sheets a NEW, identifying name, as they are copied into the destination file.
For instance, the original sheet name is "CAT", from original workbook named "ANIMALS 2018 WORLD.XLS".
I want the new sheet, in the destination file, to be named "2018-CAT" (the '2018' being the identifier that tells me what the source file was).
Possible?


Sub CombineWorkbooks()Path = "J:\CPAT Process\Excel staging\"
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy after:=ActiveWorkbook.Sheets(1)


Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop


End Sub

Artik
06-05-2019, 03:17 PM
I have the following code that merges several Excel workbooks into one (new) destination workbook. Heavily doubtful :think: :)



Possible? Possible, I think so. :)

Sub CombineWorkbooks_1()
Dim sPath As String
Dim sFilename As String
Dim Sh As Object
Dim Wbk As Workbook
Dim strYear As String
Dim calcMode As XlCalculation


sPath = "J:\CPAT Process\Excel staging\"

sFilename = Dir(sPath & "*.xlsx")

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

Do While sFilename <> ""

Set Wbk = Workbooks.Open(Filename:=sPath & sFilename, ReadOnly:=True)
strYear = Split(sFilename, " ")(1)

For Each Sh In Wbk.Sheets

With ThisWorkbook
Sh.Copy After:=.Sheets(.Sheets.Count)
On Error Resume Next
.Sheets(.Sheets.Count).Name = strYear & "-" & Sh.Name
If Err.Number <> 0 Then
MsgBox "Sheet name: '" & strYear & "-" & Sh.Name & _
"' is already exists.", vbExclamation
End If
End With

Next Sh

Wbk.Close False

sFilename = Dir()

Loop

With Application
.Calculation = calcMode
.EnableEvents = True
End With

MsgBox "Done"
End Sub

Artik

ajjava
06-07-2019, 09:56 AM
Ahhh! My friend does it again! This worked perfectly, with one caveat - I had to comment out the With Application snippet, or else the pictures couldn't be displayed (just a pic placeholder and a red x). Other than that, SUCCESS!! THANK YOU AGAIN!!!