Crear Macro de hojas con rangos de datos
Desde una hoja llamada "DATOS" como crear un rango de datos, el rango copiar y en hojas nuevas
En la primera parte del rango va desde el rango es A1:N70 de la hoja "DATOS" copia y pega el rango mencionado en la primera hoja nueva con el nombre de la celda C10 de hoja "DATOS".
En el segundo la parte del rango va desde el , A71:N140 copia de la hoja "DATOS" copia y pega el rango mencionado en la segunda hoja nueva con el nombre de la celda C80 de hoja "DATOS"., asi sucesivamente hasta llegar a la B141:N210
1 Respuesta
Respuesta de Elsa Matilde
1
¡Gracias! Elsa, por la ayuda y su respuesta
Esta sería la nueva macro. Como el rango final llega mucho más allá de N210 se evalúa si se encuentra el título de la col D para identificar el fin de rango.
Ya te estoy enviando tu libro.
Sub creaHojas_x_rgos()
'x Elsamatilde
'se recorre la hoja activa, desde A1 hasta el final, en rangos de 70 filas
Dim x As Byte 'la usaré para identificar el fin de rango
Application.ScreenUpdating = False
Sheets("DATOS").Select
Range("A1").Select 'ATENCIÓN: ajustar la fila de inicio
filini = 1 'ATENCIÓN: ajustar el nro de la 1er fila
While x = 0
'el dato para el nombre se encuentra a 9 filas del inicio
nbrehoja = Range("C" & filini + 9)
'guardo la fila x si necesito mostrar en mensaje de error
filareg = filini + 9
'selecciono el rango de 70 filas
Range("A" & filini & ":N" & filini + 69).Copy
'crea hoja, pega los datos
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
'mantiene ancho de col
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
'asigna nombre a la hoja nueva
On Error GoTo errorHoja
ActiveSheet.Name = nbrehoja
ActiveSheet.Range("A1").Select
sigo:
On Error GoTo 0
'vuelve a la hoja DATOS
Sheets("DATOS").Select
'pasa al rango sgte (salta 71 filas) y repite el bucle
filini = filini + 70
'como el título se encuentra en D1 se evalua si esa celda está vacia,
'lo que significará el fin de rango
If Range("D" & filini) = "" Then x = 1
Wend
'finalizó el proceso
Application.CutCopyMode = False
MsgBox "Fin del proceso.", , "FIN DEL PROCESO"
Exit Sub
errorHoja:
MsgBox "La hoja cuyo nombre se encuentra en fila " & filareg & " fue creada pero no se pudo asignar ese nombre." & Chr(10) & _
"Toma nota para nombrarla manualmente al finalizar el proceso. El proceso continua con el resto de los rangos.",, "ERROR"
GoTo sigo
End SubSdos!
