View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Andrew[_16_] Andrew[_16_] is offline
external usenet poster
 
Posts: 66
Default Using a macro over a number of sheets (Redux)

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



"Dominique Feteau" wrote in 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:=
_
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