EmmaFairclough
06-24-2004, 07:30 AM
I've got part of a macro completed thanks to theofficeexperts but then received a pm to visit here and thought I'd come and say hello to you lovely people!!
The macro looks like this
Sub CreateSummary()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim f As String, x As String
f = "SUMMARY"
For Each ws In ThisWorkbook.Worksheets
ws.Activate
If ActiveSheet.Name = f Then GoTo circumv1
x = ActiveSheet.Name
If Range("J65536").End(xlUp).Row = 1 Then GoTo circumv1
Range("A2", Range("J65536").End(xlUp)).Copy
With Sheets(f)
.Range("A65536").End(xlUp).Offset(1).Value = x
.Range("A65536").End(xlUp).Offset(1).PasteSpecial (xlPasteAll)
End With
circumv1:
Next ws
Sheets(f).Select
Application.ScreenUpdating = True
End Sub
It works really well except that I want it to copy over one set of headings and make the page names bold.
Any ideas??
:cool:
The macro looks like this
Sub CreateSummary()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim f As String, x As String
f = "SUMMARY"
For Each ws In ThisWorkbook.Worksheets
ws.Activate
If ActiveSheet.Name = f Then GoTo circumv1
x = ActiveSheet.Name
If Range("J65536").End(xlUp).Row = 1 Then GoTo circumv1
Range("A2", Range("J65536").End(xlUp)).Copy
With Sheets(f)
.Range("A65536").End(xlUp).Offset(1).Value = x
.Range("A65536").End(xlUp).Offset(1).PasteSpecial (xlPasteAll)
End With
circumv1:
Next ws
Sheets(f).Select
Application.ScreenUpdating = True
End Sub
It works really well except that I want it to copy over one set of headings and make the page names bold.
Any ideas??
:cool: