I got this from the microsoft news group - I wanted the sheet names copied across, but is there any way to modify this so that the page setup and Headers/footers are also transposed?
Have been trying
Worksheets(Tgt).PageSetup.RightHeader = _
Worksheets(Src).PageSetup.Rightheader
etc
but am unable to work it into the code I have. Any pointers appreciated.
Sub CopyWbkValue()
'
' ValueWbk Macro
' Macro recorded 18/03/2002 by gj
'
'
Dim MySheet As Worksheet
Dim wbNewWb As Workbook
Dim wbOldWb As Workbook
Dim shtNewSheet As Worksheet
Dim TheRange As Range
Set wbOldWb = ThisWorkbook
Dim iNumOfNewSheets As Integer
iNumOfNewSheets = Application.SheetsInNewWorkbook
With Application
.StatusBar = "Copying workbook to a new workbook..."
.ScreenUpdating = False
.SheetsInNewWorkbook = 1
Set wbNewWb = Workbooks.Add
.SheetsInNewWorkbook = iNumOfNewSheets
End With
wbNewWb.Sheets(1).Name = "DeleteMeWhenFinished"
For Each MySheet In wbOldWb.Worksheets
Set shtNewSheet = wbNewWb.Sheets.Add
shtNewSheet.Move after:=wbNewWb.Sheets(wbNewWb.Sheets.Count)
Set TheRange = MySheet.Cells
shtNewSheet.Name = MySheet.Name
TheRange.Copy
With shtNewSheet.Cells
.PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteFormats)
End With
shtNewSheet.Range("A1").Select
If Not MySheet.Visible Then
shtNewSheet.Visible = xlSheetHidden
End If
Next MySheet
wbNewWb.Sheets(wbOldWb.ActiveSheet.Index).Activate
With Application
.CutCopyMode = False
.DisplayAlerts = False
wbNewWb.Sheets("DeleteMeWhenFinished").Delete
.DisplayAlerts = True
.ScreenUpdating = True
.StatusBar = False
End With
Set MySheet = Nothing
Set wbNewWb = Nothing
Set wbOldWb = Nothing
Set shtNewSheet = Nothing
Set TheRange = Nothing
End Sub
'*****Macro by Mark Driscol
thanks
George J
This message was edited by George J on 2002-03-18 04:48