View Full Version : Macro that creates duplicates of a master sheet
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. :banghead:
I have to close excel, open the document again and start the macro again with value number 11.
Thanks for your help
lucas
01-23-2008, 08:52 AM
Well that's a major project....what do you have so far?
here you have the code.... please keep in mind i've just learned how to manage this stuff a one month ago : pray2:
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
01-23-2008, 10:21 AM
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
Ok Ron, Sorry.
Here you have it:
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.