How to combine the tabs from multi workbooks in a single workbook with renaming tabs? 1

[feipezi]

Hello,

I tried to do what I have to do to fulfill what the subject specified but not quite satisfied with what I got.

I have about 5 workbooks for each model. I was asked to copy all the tabs in each book and place them in a single workbook. However, we have 10 to 20% of the tabs have the same tab name before they are put together, which is not allowed to coexist in one workbook.

I set up an utility procedure to list all the unique tab name and the duplicated tab name as well, which helps me rename the tab name in the process and make them all unique. Unfortunately life is not that easy. Because those input workbooks are kept updating, i.e., the rename part of the process works now but may not work next week or the week after.

My question is if we can set up a WHILE/WEND loop to keep checking and renaming the tabs 'on the fly' or dynamically, instead of checking the dups first with the utility macro and then renaming the tabs with IF/THEN or SELECT statement.

thanks in advance.

The following is the code I used to test it. Even it's not working, hope it can help as a reference.


Sub CombineMultiBooksMultiTabs()
'Application.ScreenUpdating = False
Dim strPath As String
Dim oFSO As Object
Dim oFile As Object
Dim oFolder As Object
Dim obook As Object

strPath = SourceFolder
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(strPath)

For Each oFile In oFolder.Files
If oFile.Name Like "*.xlsx" Then
Set obook = Workbooks.Open(oFile)
For Each st In obook.Worksheets

If Len(st.Name) > 26 Then st.Name = Mid(st.Name, 1, 26)
Set nusheet = ThisWorkbook.Worksheets.Add
nusheet.Name = st.Name

x = 1
While st.Name = nusheet.Name

st.UsedRange.Copy ThisWorkbook.Worksheets(nusheet.Name).Cells(1, 1)

If Err = 0 Then
nusheet.Name = st.Name & "_" & x
Else: nusheet.Name = st.Name & "_" & x * 2
End If

' MsgBox st.Name & "*" & nusheet.Name
x = x + 1
Wend
Next
End If
obook.Close SaveChanges:=False
Next

Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
'Applicaton.ScreenUpdating = True
End Sub

 

[SkipVought]

Hi,

"have about 5 workbooks for each model"

Are you in control of what workbook(s) you create and use for your models?


Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[feipezi]

Hey Skip,
Yes. The thing goes like this: I have something like 15 models; each model has it's own folder where all the input files for that model are located. I don't really care how many input file (workbooks) in the folder; it can be 5 or 10 or more; the only problems I have are some tabs have the same tab name.
For instance, this is an example of a sub folder of a particular model: REF:

Public Const SourceFolder As String = "C:\Users\pl04512\Documents\Aja\tmp\REF"

Thanks.

 

[strongm]

Er, did we not cover this in thread707-1802017?

 

[feipezi]

Hello,

We talked about this before but in this aspect, or not in detail. The error I got now is 'Run-time error 1004; the name already taken. try a different one'.
thanks.

 

[Andrzejek]

You get the [tt]Run-time error 1004[/tt], but where is your [tt]error handler[/tt]...?


---- Andy

There is a great need for a sarcasm font.

 

[strongm]

Well, yes, because you seem to have ignored most of the code that I suggested you might want to try (your prerogative, of course) which wasn't about how to fix the subscript error, but how to gets Excel to do all the heavy lifting of renaming sheets without conflict (and a true copy of the sheets - your version, for example, will not maintain column widths). Of course you may have an issue with the sheets being renamed as "[tt]my_sheet (x)[/tt]" rather than "[tt]my_sheet_x[/tt]"

Given your apparent simplified requirements my code could also be simplified somewhat(and it might even make sense to get rid of the helper sub RenameSheets, and put the functionality inline, but I leave that as an exercise for the interested reader ...):

[blue]Sub CombineMultiBooksMultiTabs()
    Application.ScreenUpdating = False
    Dim strPath As String
    Dim oFSO As Object
    Dim oFile As Object
    Dim oFolder As Object
    
    Dim mainWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
    Dim sourceWorkbook As Workbook

    strPath = SourceFolder
    
    Set mainWorkbook = Application.ActiveWorkbook
    With CreateObject("Scripting.FileSystemObject").GetFolder(strPath)
        For Each oFile In .Files
            If oFile.Name Like "*.xlsx" Then
                Workbooks.Open oFile
                Set sourceWorkbook = ActiveWorkbook
                RenameSheets sourceWorkbook
                For Each tempWorkSheet In sourceWorkbook.Worksheets
                    tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
                Next
                sourceWorkbook.Close SaveChanges:=False
            End If
        Next
    End With
    
    Application.ScreenUpdating = True
End Sub


Private Sub RenameSheets(oBook As Workbook)
    Dim st As Worksheet
    
    For Each st In oBook.Worksheets
        st.Name = Mid(st.Name, 1, 26)
    Next
    
End Sub[/blue]

 

[feipezi]

Thanks a lot strongm for working on the issues that I have, again.

I don't have the error code of '1004' no more by taking your code (the current one and the one sent in Apr).

One thing that I don't quite understand is how come your code won't produce the error code (like name is taken, try a different one...). In another word, how can you let Excel to assign index to the duplicated tabs instead of getting errors.

Thanks again.

You sent me the following code in Apr. I didn't realize it was the solution to my issues until now. I thought you were trying to tell me how SELECT/CASE statements can work in the situation. I apologize.


Sub CombineMultiBooksMultiTabsCARD()
Application.ScreenUpdating = False
Dim strPath As String
Dim oFile As Object
Dim mainWorkbook As Workbook
Dim tempWorkSheet As Worksheet
Dim sourceWorkbook As Workbook

strPath = SourceFolder

Set mainWorkbook = Application.ActiveWorkbook
With CreateObject("Scripting.FileSystemObject").GetFolder(strPath)
For Each oFile In .Files
If oFile.Name Like "*.xlsx" Then
Workbooks.Open oFile
Set sourceWorkbook = ActiveWorkbook
RenameSheets sourceWorkbook
For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Next
sourceWorkbook.Close SaveChanges:=False
End If
Next
End With

Application.ScreenUpdating = True
End Sub

Private Sub RenameSheets(oBook As Workbook)
Dim st As Worksheet

For Each st In oBook.Worksheets
st.Name = Left(st.Name, 23)
Select Case True
Case InStr(oBook.Name, "CCARD")
st.Name = st.Name & IIf(Len(st.Name) < 25, "_CCARD", "_CC")
Case InStr(oBook.Name, "CALCOP")
st.Name = st.Name & IIf(Len(st.Name) < 25, "_CALCP", "_CAL")
Case InStr(oBook.Name, "_Fund")
st.Name = st.Name & IIf(Len(st.Name) < 25, "_FUND", "_FUN")
End Select
Next

End Sub

 

[strongm]

>how can you let Excel to assign index to the duplicated tabs

It is a built-in bonus feature of the Worksheet.Copy method. As I said, we let Excel do the hard work

 

[Andrzejek]

I wonder if feipezi will ever format his/her [tt]CODE[/tt] as code in his/her posts...
I guess strongm's posts do not provide any hints... :-(


---- Andy

There is a great need for a sarcasm font.

 

[strongm]

>trying to tell me how SELECT/CASE statements can work in the situation

Well, yes - that as well ;-)

 

[feipezi]

Hello guys,

"It is a built-in bonus feature of the Worksheet.Copy method". That being the case, how come I got '1004, ...tab name has been taken, try a different one'. The so-called "bonus feature" only works in Copy method, not when naming the tabs, correct?

Hey Andy, could you let me know what kind of format you're talking about?
Thanks.
John Z

 

[strongm]

>The so-called "bonus feature" only works in Copy method

No, it is even more specific than that - it only works in the Worksheet.Copy method, not the Range.Copy method that you are using; they are NOT the same.

 

[Andrzejek]

Either do:[tt][ignore]

Put your code in here

[/ignore][/tt]

Or, highlight the text of your code and click on:

Always preview your posts.


---- Andy

There is a great need for a sarcasm font.

 

[feipezi]

Thanks Andy for the tips. I usually do .... Now I know how to use

.