Using a macro over a number of sheets (Redux)

  • Thread starter Thread starter Dominique Feteau
  • Start date Start date
D

Dominique Feteau

Heres the code I'm using. Very self explanatory. Only problem is that when
it has finished that first sheet, it doesnt move to the next sheet. not
sure why.


Sub Access()

For Each Sheet In Worksheets
Windows("Activebillings2004.xls").Activate

Dim RenamSheet As String

'here is where it copies assuming that workbook and sheet i have copied
is selected
Range("B26:M28").Select
Selection.Copy
Windows("Access.xls").Activate
'add the new sheet and rename it
Sheets.Add
RenamSheet = InputBox("Rename Sheet")
ActiveSheet.Name = RenamSheet
Range("C1").Select
'here is where it pastes that new info along with some other formatting
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=True
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "January"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B12"), Type:=xlFillDefault
Range("B1:B12").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Annual Subscription Fees"
Range("A2").Select
Columns("A:A").EntireColumn.AutoFit
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A12"), Type:=xlFillDefault
Range("A1:A12").Select
Range("A13").Select
ActiveCell.FormulaR1C1 = "Consultative Support"
Range("A13").Select
Selection.AutoFill Destination:=Range("A13:A24"), Type:=xlFillDefault
Range("A13:A24").Select
Range("A25").Select
ActiveCell.FormulaR1C1 = "Production"
Range("A25").Select
Selection.AutoFill Destination:=Range("A25:A36"), Type:=xlFillDefault
Range("A25:A36").Select
Range("B1:B12").Select
Selection.Copy
Range("B13").Select
ActiveSheet.Paste
Range("B25").Select
ActiveSheet.Paste
Range("D1:D12").Select
Application.CutCopyMode = False
Selection.Cut
Range("C13").Select
ActiveSheet.Paste
Range("E1:E12").Select
Selection.Cut
Range("C25").Select
ActiveSheet.Paste
Range("A1").Select
'then goes back to the original file
Windows("Activebillings2004.xls").Activate

Next Sheet

End Sub
 
Hi Dominique;

Try moving

Windows("Activebillings2004.xls").Activate

to the first line instead of being in the loop.

Thanks,

Greg
-----Original Message-----
Heres the code I'm using. Very self explanatory. Only problem is that when
it has finished that first sheet, it doesnt move to the next sheet. not
sure why.


Sub Access()

For Each Sheet In Worksheets
Windows("Activebillings2004.xls").Activate

Dim RenamSheet As String

'here is where it copies assuming that workbook and sheet i have copied
is selected
Range("B26:M28").Select
Selection.Copy
Windows("Access.xls").Activate
'add the new sheet and rename it
Sheets.Add
RenamSheet = InputBox("Rename Sheet")
ActiveSheet.Name = RenamSheet
Range("C1").Select
'here is where it pastes that new info along with some other formatting
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:=
 
i am not sure because i cannot test but i think it is your
for statement.
change for each sheet in worksheets
to
for each sheets in ActiveWorkbook
But what ever, the problem is in the for statement, you
just need the correct syntax.
-----Original Message-----
Heres the code I'm using. Very self explanatory. Only problem is that when
it has finished that first sheet, it doesnt move to the next sheet. not
sure why.


Sub Access()

For Each Sheet In Worksheets
Windows("Activebillings2004.xls").Activate

Dim RenamSheet As String

'here is where it copies assuming that workbook and sheet i have copied
is selected
Range("B26:M28").Select
Selection.Copy
Windows("Access.xls").Activate
'add the new sheet and rename it
Sheets.Add
RenamSheet = InputBox("Rename Sheet")
ActiveSheet.Name = RenamSheet
Range("C1").Select
'here is where it pastes that new info along with some other formatting
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:=
 
After a very quick look at your code I can't see why it shdn't go to
the next sheet but you could streamline it significantly by actually
setting references to the workbooks involved and this may well resolve
the problem. The below is just a short example to show you what I
mean. You can then use eg. ws.Range("A1").Copy and
wsNew.Range("A1").Paste etc. - ie. make use of the intellisence.

Hope that is of some help,
Andrew

Sub Access()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim i As Integer

Set wb1 = Workbooks("Activebillings2004.xls")
Set wb2 = Workbooks("Access.xls")

For Each ws In wb1.Worksheets
Set wsNew = wb2.Worksheets.Add
wsNew.Name = "Name stored from inp box" & i
i = i + 1
Next

Set ws = Nothing
Set wsNew = Nothing
Set wb1 = Nothing
Set wb2 = Nothing

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top