Macro Cortar filas de una hoja

Hola experto,
Necesito resolver un problema con excel a través de una macro.
Se trata de cortar filas en una hoja y pegarlas en varias hojas separándolas en función del valor que tengan en una columna específica.
Resumiendo:
hoja 1:
Columna A
Fila1PABLO
Fila2PABLO
Fila3PABLO
Fila4 MARTA
Fila5 MARTA
Fila6 CARLOS
Quiero que estas filas de la hoja 1 se me distribuyan en tantas hojas como valores diferentes tengo en la columna A, en este caso 3 hojas (hoja PABLO,hoja MARTA y hoja CARLOS).
La hoja CARLOS tendrá 3 filas
La hoja MARTA tendrá 2 filas
La hoja Carlos tendrá 1 fila
GRACIAS!
1

1 respuesta

Respuesta
1
En un modulo pega esto:
Sub crea_hoja()
Dim i As Integer
Dim n As Integer
Dim hoja As String
Application.ScreenUpdating = False
Worksheets.Item(1).Select
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("$B$1:$B$65535").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B1").Select
[b65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
[A65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
n = [b65536].Value
For i = 1 To n
   Sheets.Add after:=Worksheets(Worksheets.Count)
   Worksheets.Item(Worksheets.Count).Name = Worksheets.Item(1).Range("B" & i)
DoEvents
Next
Worksheets.Item(1).Select
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    [a1].Select
n = [A65536].Value
    For i = 1 To n
        Worksheets.Item(1).Select
       Worksheets.Item(1).Range("A" & i).Select
       Selection.EntireRow.Select
       Selection.Cut
       hoja = Worksheets.Item(1).Range("A" & i)
       Sheets(hoja).Select
       Range("A65536").Select
       Selection.End(xlUp).Select
       Selection.Offset(1, 0).Select
       ActiveSheet.Paste
    DoEvents
    Next
Worksheets.Item(1).Select
    [A65536].Clear
    [a1].Select
Application.ScreenUpdating = True
MsgBox "Terminado", vbInformation
End Sub
se entiende que los datos estan en la hoja 1 desde A1 ( sin rotulos)
ejecutala con ALT + F8
Un millón de gracias por tu respuesta, he probado la macro y funciona perfectamente aunque creo que pasaré bastantes horas intentando entenderla.
saludos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas