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

Respuesta
1

Puedes poner una imagen de tu hoja1.

¿Cómo identificas entre rango y rango de celdas a copiar?

¿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 Sub


Nota: Las hojas a crear no deben existir.

Respuesta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas