Saltar al contenido

Copiar y renombrar hojas con fecha del mes en curso

publicado

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

Featured Replies

publicado

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.

publicado
  • Autor

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,

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.