Copiar y renombrar hojas con fecha del mes en curso

[MSN67]

Buen domingo a tdos!!!

Tengo una macro que me añade nuevas hojas en blanco renombrandolas con las fechas de todo el mes en curso.

Ahora necesitaria que esta misma macro me copie la hoja "Plantilla" y las renombre como hasta ahora .

Set wks = .Worksheets.[B][COLOR=#000080]Add[/COLOR][/B](after:=.Worksheets(.Sheets.Count))[/CODE]

Quisiera cambiar la función de [b][color=#000080]Add[/color][/b] por [b][color=#ff0000]Copy[/color][/b], he probado con algunas variantes, pero hasta ahora siempre con error.

Alguna sugerencia ???

Gracias por vuestra ayuda :courage:

Book1.rar

[jose71]

Hola,

He incluido un par de lineas en tu código para copiar la plantilla, lo compruebas y nos cuentas.

Sub testme()Dim i As Integer

Dim wks As Worksheet

Dim myDate As Variant

Dim iDate As Long

Dim StartDate As Date

Dim FinishDate As Date

[COLOR=#ff0000]Dim temp As String[/COLOR]



myDate = ActiveSheet.Range("A1").Value



If IsDate(myDate) = False Then

MsgBox "Please enter a date"

Exit Sub

End If



StartDate = DateSerial(Year(myDate), Month(myDate), 1)

FinishDate = DateSerial(Year(myDate), Month(myDate) + 1, 0)



For iDate = StartDate To FinishDate

Select Case Weekday(iDate)

Case Is = vbSunday

'do nothing

Case Else



With ActiveWorkbook

Set wks = .Worksheets.Add(after:=.Worksheets(.Sheets.Count))



On Error Resume Next

wks.Name = Format(iDate, "dd-mm-yyyy - dddd")

[COLOR=#ff0000]temp = wks.Name[/COLOR]

[COLOR=#ff0000]Worksheets("Planning").Range("A2:G20").Copy Destination:=Worksheets(temp).Range("A2")[/COLOR]

If Err.Number <> 0 Then

Err.Clear

MsgBox "Could not rename: " & wks.Name

End If

On Error GoTo 0

End With

End Select

Next iDate

End Sub[/CODE]

Un saludo.

[MSN67]

Hola Jose71,

He probado tu sugerencia y funziona, hace lo que necesitaba, pero no me mantiene ni estructura, ni formato.

Añadiendo codigo de formato, me crea las hojas una a una y en blanco.

Saludos,