Copiar rango celdas contenidas en hoja1 archivo datos.xlsx y generar para cada rango una nueva hoja en datos.xlsx
Dam, favor se requiere una macro excel que copie rangos de celdas contenidas en la hoja1 y genere nueva(s) hoja(s) con nombre el "titulo de la columna G" del rango
Contenido del archivo Datos.xlsx:
Hoja1
A ... G Titulo I ... N (no vacias)
9 " Titulo A" Titulo0 Titulo I ...
...
...
...
...
A ... G Titulo I ... K (no vacias)
" Titulo A" Titulo1 Titulo I ...
...
...
...
...
...
...
A ... G Titulo I ... Z (no vacias)
" Titulo A" Titulon Titulo I ...
...
...
...
Resultado en el mismo archivo Datos.xlsx y Hojas con nombres:
Hoja1 Titulo0 Titulo1 ... Titulon
2 Respuestas
Esto te puede ayudar
https://www.youtube.com/watch?v=MAonA49rjLk&list=PLdK9H5dMIfQgUh1txO92v_PSBZu4XQ4MB
¿Cómo identificas entre rango y rango de celdas a copiar?
Puedes responder la duda para continuar...
Nota: Una cosa que debes tener en cuenta cuando haces una pregunta en un foro ... las personas a las que solicitas ayuda no saben absolutamente nada acerca de tus datos, absolutamente nada sobre cómo están en el libro de trabajo, absolutamente nada sobre lo que tú quieres que se haga con él y absolutamente nada sobre cómo quieres el resultado ... debes ser muy específico al describir cada una de estas áreas, en detalle, y no debes suponer que seremos capaces de "resolverlo" por nuestra cuenta. Recuerda, nos estás pidiendo ayuda ... así que ayúdanos, brindando la información que necesitamos para hacerlo, incluso si esa información te parece "obvia" (recuerda, sólo es obvia para ti porque estás familiarizado con tus datos, su diseño y el objetivo general para ellos).
Disculpas Dam
Anexo nueva versión, gracias
Prueba la siguiente:
Sub Copiar_Celdas()
Dim sh As Worksheet
Dim r As Range, f As Range
Dim ini As Long, fin As Long, lr As Long, lc As Long
Dim cell As String
'
Application.ScreenUpdating = False
'
Set sh = Sheets("Hoja1")
lr = sh.Range("B" & Rows.Count).End(3).Row + 1
sh.Range("B" & lr).Value = "Descripción"
Set r = sh.Range("B:B")
'
Set f = r.Find("Descripción", , xlValues, xlWhole, , False)
If Not f Is Nothing Then
cell = f.Address
Do
ini = f.Row
lc = sh.Cells(ini, Columns.Count).End(1).Column
Set f = r.FindNext(f)
fin = f.Row
If fin > ini Then
Sheets.Add(, Sheets(Sheets.Count)).Name = sh.Range("G" & ini).Value
sh.Range("B" & ini, sh.Cells(fin - 1, lc)).Copy
Range("A1").PasteSpecial xlPasteAll
Range("A1").PasteSpecial xlPasteValues
End If
Loop While Not f Is Nothing And f.Address <> cell
End If
sh.Range("B" & lr).Value = ""
End SubNota: Las hojas a crear no deben existir.