COMO ASIGNAR CADA DIA DE UN CALEDARIO A CADA HOJA

[carlosleal23]

Hola un cordial saludo a todos.

 Tengo una hoja con un formato de calendario y tengo 365 hojas cada una con nombre de un dia mes y año  en especifico agradecería me ayuden a como puedo realizar la vinculacion de cada dia del calendario con cada hoja respectivamente sin hacerlo de forma manual , ya que es muy laborioso dado que lo tengo que hacer de una por una.

 

adjunto coloco un ejemplo de lo que tengo gracias.

Libro1.xlsm

[Antoni]

Abre el adjunto y pulsa el botón  GENERAR HOJAS y luego pulsa sobre cualquier fecha del calendario para ir a la hoja deseada.

Observa que he añadido 2 botones en la hoja CALENDARIO, uno para generar las hojas y otro para eliminarlas.

También he añadido una flechita azul en las hojas generadas para volver a la hoja CALENDARIO.

Estas son las macros:

En la hoja CALENDARIO:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d As Integer, m As Integer, a As Integer
On Error Resume Next
If IsNumeric(Target) Then
   If Not Target = "" Then
      x = Int((Target.Row - 6) / 9)
      y = Int((Target.Column - 5) / 8) + 1
      m = x * 6 + y
      d = Target
      a = Right([E3], 4)
      Sheets(Format(d, "00") & "-" & Format(m, "00") & "-" & a).Activate
   End If
End If
End Sub

En el Módulo1:

Sub GenerarHojas()
Application.ScreenUpdating = False
Application.CopyObjectsWithCells = True
Dim a As Integer
a = Right([E3], 4)
With Sheets("ORIGI")
   For fecha = CDate("01/01/" & a) To CDate("31/12/" & a) '<-- Periodo a generar
      .Copy After:=Sheets(Sheets.Count)
      ActiveSheet.Name = Format(fecha, "dd-mm-yyyy")
      [B4] = [B4] & " " & fecha
   Next
End With
Volver
End Sub
'--
Sub EliminarHojas(): On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim a As Integer
a = Right([E3], 4)
For fecha = CDate("01/01/" & a) To CDate("31/12/" & a) '<-- Periodo a eliminar
   Sheets(Format(fecha, "dd-mm-yyyy")).Delete
Next
End Sub
'--
Sub Volver()
Sheets("CALENDARIO").Activate
End Sub

 

Libro1 (15).xlsm

Editado el el 16 de abril por Antoni

[carlosleal23]

Muchas gracias me a servido de mucho su colaboaracion y ayuda.

 

Excelente aporte amigo.

[carlosleal23]

En 16/4/2024 at 4:56 , Antoni dijo:

Abre el adjunto y pulsa el botón  GENERAR HOJAS y luego pulsa sobre cualquier fecha del calendario para ir a la hoja deseada.

Observa que he añadido 2 botones en la hoja CALENDARIO, uno para generar las hojas y otro para eliminarlas.

También he añadido una flechita azul en las hojas generadas para volver a la hoja CALENDARIO.

Estas son las macros:

En la hoja CALENDARIO:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d As Integer, m As Integer, a As Integer
On Error Resume Next
If IsNumeric(Target) Then
   If Not Target = "" Then
      x = Int((Target.Row - 6) / 9)
      y = Int((Target.Column - 5) / 8) + 1
      m = x * 6 + y
      d = Target
      a = Right([E3], 4)
      Sheets(Format(d, "00") & "-" & Format(m, "00") & "-" & a).Activate
   End If
End If
End Sub

En el Módulo1:

Sub GenerarHojas()
Application.ScreenUpdating = False
Application.CopyObjectsWithCells = True
Dim a As Integer
a = Right([E3], 4)
With Sheets("ORIGI")
   For fecha = CDate("01/01/" & a) To CDate("31/12/" & a) '<-- Periodo a generar
      .Copy After:=Sheets(Sheets.Count)
      ActiveSheet.Name = Format(fecha, "dd-mm-yyyy")
      [B4] = [B4] & " " & fecha
   Next
End With
Volver
End Sub
'--
Sub EliminarHojas(): On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim a As Integer
a = Right([E3], 4)
For fecha = CDate("01/01/" & a) To CDate("31/12/" & a) '<-- Periodo a eliminar
   Sheets(Format(fecha, "dd-mm-yyyy")).Delete
Next
End Sub
'--
Sub Volver()
Sheets("CALENDARIO").Activate
End Sub

 

Libro1 (15).xlsm 37.94 kB · 3 descargas

amigo antoni necesito de su ayuda con otro archivo de excel el cual no puedo subir por que pesa mas de 4 mb