Macro that creates duplicates of a master sheet

[rir1]

Dear all,
I'm trying to run a macro which :
1. Creates a duplicate of a master sheet (with graphs),
2. Changes one value in this new sheet
3. Update formulas
4, Paste all the results as values.


Once it worked well for 10 times, it stops.

I have to close excel, open the document again and start the macro again with value number 11.

Thanks for your help

[lucas]

Well that's a major project....what do you have so far?

[rir1]

here you have the code.... please keep in mind i've just learned how to manage this stuff a one month ago


Sub a_Crea_Hojas_paises()
Dim fila As Integer
Dim r As Integer
Dim inicio As String
Dim final As String
Dim j As Range
inicio = "m37"
final = "m64"
fila = 0
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
For Each j In Workbooks("Master.xls").Worksheets("bbdd&SUPPORT").Range(inicio & ":" & final)


Windows("Master.xls").Activate
Sheets("MODELCOUNT").Select
Sheets("MODELCOUNT").Copy Before:=Sheets("MODELCOUNT")
Application.CutCopyMode = False
Call ClearClipboard
Sheets("MODELCOUNT (2)").Name = j
Range("AT7").Value = Worksheets("bbdd&SUPPORT").Range(inicio).Offset(fila, 1).Value
Calculate

Range("a1:dg275").Copy
Range("a1:dg275").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.CutCopyMode = False
Call ClearClipboard

'to update graphs

Sheets(j.Value).Activate
ActiveSheet.ChartObjects("Grafmonth").Activate
Call cambia_escala(Range("e139").Value, Range("e140").Value)
Call cambia_colores("Grafmonth", "e139", 7)
ActiveSheet.ChartObjects("Grafqtd").Activate
Call cambia_escala(Range("s139").Value, Range("s140").Value)
Call cambia_colores("Grafqtd", "s139", 7)
ActiveSheet.ChartObjects("Grafytd").Activate
Call cambia_escala(Range("ag139").Value, Range("ag140").Value)
Call cambia_colores("Grafytd", "ag139", 7)


Workbooks("master.xls").Sheets(j.Value).Copy Before:=Workbooks("cierre.xls").Sheets("FIN")
Application.CutCopyMode = False
Call ClearClipboard
Application.DisplayAlerts = False
Workbooks("master.xls").Sheets(j.Value).Delete
Application.DisplayAlerts = True

fila = fila + 1
Next j
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
End Sub

[RonMcK]

rir1,

A suggestion. When you paste in VBA code, first click the 'vba' button, then, type (or copy-paste-insert) your code between the tags. When your message posts, the code will retain the indenting you used.

Thanks,
Ron

[rir1]

Ok Ron, Sorry.
Here you have it:
[VBA]Sub a_Crea_Hojas_paises()
Dim fila As Integer
Dim r As Integer
Dim inicio As String
Dim final As String

inicio = "m58"
final = "m64"
fila = 0
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
For Each J In Worksheets("bbdd&SUPPORT").Range(inicio & ":" & final)
If fila = 7 Then
Workbooks("Master.xls").Save
Else
End If

Windows("Master.xls").Activate
Sheets("MODELCOUNT").Select
Sheets("MODELCOUNT").Copy Before:=Sheets("MODELCOUNT")
Application.CutCopyMode = False
Call ClearClipboard
Sheets("MODELCOUNT (2)").Name = J
Range("AT7").Value = Worksheets("bbdd&SUPPORT").Range(inicio).Offset(fila, 1).Value
Calculate
Range("a1:dg275").Copy
Range("a1:dg275").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Call ClearClipboard

'To update graphs in the sheet
Sheets(J.Value).Activate
ActiveSheet.ChartObjects("Grafmonth").Activate
Call cambia_escala(Range("e139").Value, Range("e140").Value)
Call cambia_colores("Grafmonth", "e139", 7)
ActiveSheet.ChartObjects("Grafqtd").Activate
Call cambia_escala(Range("s139").Value, Range("s140").Value)
Call cambia_colores("Grafqtd", "s139", 7)
ActiveSheet.ChartObjects("Grafytd").Activate
Call cambia_escala(Range("ag139").Value, Range("ag140").Value)
Call cambia_colores("Grafytd", "ag139", 7)


Workbooks("master.xls").Sheets(j.Value).Copy Before:=Workbooks("cierre.xls").Sheets("FIN")
Application.CutCopyMode = False
Call ClearClipboard
Application.DisplayAlerts = False
Workbooks("master.xls").Sheets(j.Value).Delete
Application.DisplayAlerts = True

Workbooks("Cierre.xls").Save

fila = fila + 1
Next J
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
End Sub[/VBA]