Macro para nombrar archivo con fecha y ubicación

Estoy intentando resolver la pegunta, me está costando más de lo que pensaba, espera un poco.

Ya lo tengo, aunque ahora que lo pienso no sé si es esto lo que quieres, pero lo que hubiera que cambiar no sería difícil tras esto. Ye he hecho que elijas la ciudad que quieres crear el libro, no sé si querías que se crearan todos de golpe.

Por motivos de que lo solo hace falta hacer una vez, solo se hace una, he creado una macro paa que se ejecute al inicio, debes introducirla en el módulo ThisWorkbook

Private Sub Workbook_Open()
With Worksheets("Crear Libro").ListCiudades
     .ListFillRange = "Ciudades!A1:A" & Worksheets("Ciudades").Range("A65536").End(xlUp).Row
     .ListIndex = -1
End With
End Sub

Para proporcionar los datos de las ciudades al ListBox llamado ListCiudades los introduzco en una hoja llamada Ciudades. Se pueden añadir más ciudades al final pero es necesario cerrar y abrir el libro para que las reconozca.

Y luego se usa el evento click del ListBox para generar los libros nuevos. El problema era que no funcionaba cuando se hacía click sobre la misma ciudad que estaba seleccionada, después de mil inventos he descubierto que la forma más sencilla es usar el evento doble click, así cuando queramos crear el libro de la celda que está seleccionada haremos doble click en lugar de sencillo. Estas macros se introducen en un módulo que creamos

Private Sub ListCiudades_Click()
Dim ListaMeses() As Variant
ListaMeses = Array("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", _
             "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
Fecha = Day(Date) & " de " & ListaMeses(Month(Date) - 1)
NombreLibro = "Rprt_" & ListCiudades & "_" & Fecha & " de " & Year(Date) & ".xlsx"
Application.ScreenUpdating = False
With Workbooks.Add
     .Worksheets("Hoja1").Name = Fecha
     Application.DisplayAlerts = False
     .Worksheets("Hoja2").Delete
     .Worksheets("Hoja3").Delete
     Application.DisplayAlerts = True
     On Error Resume Next
     .SaveAs (NombreLibro)
     .Saved = True
     .Close
     On Error GoTo 0
End With
Application.ScreenUpdating = True
respuesta = MsgBox("¿Quiere abrir el libro " & NombreLibro, vbInformation + vbYesNo, "Abrir libro")
If respuesta = vbYes Then Workbooks.Open (NombreLibro)
End Sub
Private Sub ListCiudades_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call ListCiudades_Click
End Sub

Ahora te mandaré el libro para que lo pruebes. Y si hay que cambiar algo me lo dices, y si ya está bien no olvides puntuar.

Parece que en tablón no aparece la respuesta y ya la mande hace horas. A ver si se refresca mandando esto.