merge workbook\rename worksheet's\save as

FROGGER24

Well-known Member
Joined
May 22, 2004
Messages
704
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
I am using Excel 97. I would like to open up several workbooks and merge them into one workbook.After the worksheets are merged into new workbook I would like to rename each sheet according to the value in cell "T2" then sort the worksheets ascending.Then rename the workbook to the value in cell "L2" then save to my h drive H:\seeblue\
Thanks for input
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

FROGGER24

Well-known Member
Joined
May 22, 2004
Messages
704
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
I found this code on here and when I use it in Excel 2002 it appears to work ok. When I import into Excel 97 it stops running at this location
"ActiveSheet.Move before:=Workbooks(1).Sheets(1)"

sub macro()
Do While Workbooks.count > 1
Workbooks(2).Sheets(1).Activate
ActiveSheet.Move before:=Workbooks(1).Sheets(1)
Loop
end sub

Any help would be appreciated
 

FROGGER24

Well-known Member
Joined
May 22, 2004
Messages
704
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
I found this code on here and would like to modify it to rename the worksheet according to the value in "t2", would also like to get rid of the message box's

Option Explicit

Sub CopyWorksheets2()

Dim filenames As Variant
Dim strActiveBook As String
Dim strSourceDataFile As String
Dim wSht As Worksheet, wSht2 As Worksheet
Dim allwShts As Sheets, allwShts2 As Sheets
Dim Sheetname As String, response As String
Dim counter As Integer

Application.DisplayAlerts = False
' ActiveWorkbook.Save
'Check workbook
CheckWorkBook
intResponse = MsgBox("This macro will copy all worksheets from selected files to the current workbook. Continue?", vbOKCancel, "Copy Worksheets to Current File")
If intResponse = vbOK Then
strActiveBook = ActiveWorkbook.Name

' Create array of filenames; the True is for multi-select
filenames = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , , , True)
On Error GoTo 1000
If filenames = False Then Exit Sub
1000
On Error GoTo 0

counter = 1

' ubound determines how many items in the array
On Error GoTo quit

response = MsgBox("Retain Original Worksheet Names? (If No, then each copied worksheet will be given the name of the Excel file from which it came.", vbYesNo, "Copy Worksheets")
Application.ScreenUpdating = False
If response = vbNo Then
While counter <= UBound(filenames)

'Opens the selected files
Workbooks.Open filenames(counter)
strSourceDataFile = ActiveWorkbook.Name
If strSourceDataFile <> strActiveBook Then
Set allwShts = Worksheets
For Each wSht In allwShts
Workbooks(strSourceDataFile).Activate

If wSht.Visible = True Then
Sheets(wSht.Name).Select
Sheets(wSht.Name).Copy before:= _
Workbooks(strActiveBook).Sheets(1)
Sheetname = Left(strSourceDataFile, Len(strSourceDataFile) - 4)
Workbooks(strActiveBook).Activate
'Check to see if a Sheet already has the name
If SheetExists(Sheetname) = True Then
ActiveSheet.Name = Left(strSourceDataFile, Len(strSourceDataFile) - 4) & "(" & wSht.Index & ")"
Else
ActiveSheet.Name = Left(strSourceDataFile, Len(strSourceDataFile) - 4)
End If
End If

Next wSht
Workbooks(strSourceDataFile).Activate
ActiveWorkbook.Close

' displays file name in a message box
MsgBox strSourceDataFile & " Has Been Processed", vbOKOnly + vbInformation, "File Processed"
End If
'increment counter
counter = counter + 1
Wend
Else
While counter <= UBound(filenames)
'Opens the selected files
Workbooks.Open filenames(counter)
strSourceDataFile = ActiveWorkbook.Name
If strSourceDataFile <> strActiveBook Then
'Copy all worksheets except "Specifications"
Set allwShts = Worksheets
For Each wSht In allwShts
If wSht.Visible = True Then
Workbooks(strSourceDataFile).Activate
Sheets(wSht.Name).Select
Sheets(wSht.Name).Copy before:= _
Workbooks(strActiveBook).Sheets(1)
End If
Next wSht
Workbooks(strSourceDataFile).Activate
ActiveWorkbook.Close

' displays file name in a message box
MsgBox strSourceDataFile & " Has Been Processed", vbOKOnly + vbInformation, "File Processed"
End If
'increment counter
counter = counter + 1
Wend
End If

quit:
If Err <> 0 Then
MsgBox "An Error Occurred Trying to open the File. Please close any open Excel files and try again", vbOKOnly + vbExclamation, "File Open Error"
On Error GoTo 0
End If
End If
Set allwShts = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True



End Sub
Private Function SheetExists(sname) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
On Error GoTo 0
End Function
 

Forum statistics

Threads
1,181,439
Messages
5,929,919
Members
436,705
Latest member
Priti19

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