Duplicate sheets?
(I'm sorry, I'm guessing lots of people on holiday, etc., so didn't
want to bother the group with yet another request for help. I did
something I've never done before; I've signed up with a forum. The
new person starts Tuesday, so really needed a solution for this
workbook and I'm just not good enough to figure out big changes on my
own. I had great help over there. I certainly did not write this
code myself but hope it's okay to post the solution. I know that when
people google for questions and solutions, our posts help a lot. I've
certainly done more in last 6 months from googling than I've actually
posted, so I can attest to this! <g).
Here is a solution that I've tested and seems to work just great:
------------------------------------
Function ShExists(ShName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(ShName)
On Error GoTo 0
If Not ws Is Nothing Then ShExists = True
End Function
Sub DuplicateSheetsTWICE_Plus_Rename()
' This provides a means to split a large workbook with bilingual data
into two workbooks, languages separate.
' At this contract, complex mail merge was used on the bilingual one
which created headaches.
' - By splitting the book, half the logistical problems will be
eliminated.
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If Not ShExists(wks.Name & Chr(32) & "E") Then
wks.Copy After:=ThisWorkbook.Worksheets
(ThisWorkbook.Worksheets.Count)
ThisWorkbook.Worksheets
(ThisWorkbook.Worksheets.Count).Name _
= wks.Name & Chr(32) & "E"
End If
If Not ShExists(wks.Name & Chr(32) & "F") Then
wks.Copy After:=ThisWorkbook.Worksheets
(ThisWorkbook.Worksheets.Count)
ThisWorkbook.Worksheets
(ThisWorkbook.Worksheets.Count).Name _
= wks.Name & Chr(32) & "F"
End If
Next
End Sub
------------------------------------
Thank you. So this one is resolved.
Cheers! :oD
|