Macro copiar datos únicos a otro hoja

Necesito una macro que me copie solo valores únicos a otra hoja. Adjunto el código que generé, pero me pega los valores a partir de la celda C8, cuando debería de pegar siempre a partir de la celda C7.

Private Sub CommandButton3_Click()
'Borrar datos A7:E26 en Hoja "PACKING"
    Sheets("PACKING").Select
    Range("A7:E26").Select
    Selection.ClearContents
'Copiar Columna E de Hoja "REPORT" a partir de Fila 2
    Sheets("Report").Select
    Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).Copy
'Pegar en Hoja "PACKING" a partir de C7
    Sheets("PACKING").Select
    Range("$C$7").Select
    Selection.PasteSpecial Paste:=xlPasteValues
'Quitar duplicados en rango copiado
    ActiveSheet.Range("$C$7:$C$" & Range("C" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
'Copiar formato de celda de Fila 7 a Filas 8:26
    Rows("7:7").Select
    Selection.Copy
    Rows("7:26").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B7").Select
End Sub

2 Respuestas

Respuesta
3

Ya probé la macro y sí pone los datos en la C7, tal vez tengas espacios o blancos en alguna o algunas celdas de la columna E.

Siempre vas a copiar desde la celda E2 hasta la E26, o hasta la última celda de la columna E. Porque entonces habría que limpiar todas las filas de la C de la hoja "Packing"


Le hice unos cambios a tu macro:

Private Sub CommandButton3_Click()
    Application.ScreenUpdating = False
    Set h1 = Sheets("Report")
    Set h2 = Sheets("PACKING")
'Borrar datos A7:E26 en Hoja "PACKING"
    h2.Range("A7:E26").ClearContents
'Copiar Columna E de Hoja "REPORT" a partir de Fila 2
    h1.Range("E2:E" & h1.Range("E" & Rows.Count).End(xlUp).Row).Copy
'Pegar en Hoja "PACKING" a partir de C7
    h2.Range("C7").PasteSpecial Paste:=xlPasteValues
'Quitar duplicados en rango copiado
    h2.Range("C7:C" & h2.Range("C" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
'Copiar formato de celda de Fila 7 a Filas 8:26
    h2.Rows("7:7").Copy
    h2.Rows("7:26").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    h2.Select
    Range("B7").Select
    Application.ScreenUpdating = True
    MsgBox "fin"
End Sub


Si siempre es hasta la última fila, entonces utiliza la siguiente:

Private Sub CommandButton3_Click()
    Application.ScreenUpdating = False
    Set h1 = Sheets("Report")
    Set h2 = Sheets("PACKING")
'Borrar datos A7:E26 en Hoja "PACKING"
    u2 = h2.Range("C" & Rows.Count).End(xlUp).Row
    h2.Range("A7:E" & u2).ClearContents
'Copiar Columna E de Hoja "REPORT" a partir de Fila 2
    h1.Range("E2:E" & h1.Range("E" & Rows.Count).End(xlUp).Row).Copy
'Pegar en Hoja "PACKING" a partir de C7
    h2.Range("C7").PasteSpecial Paste:=xlPasteValues
'Quitar duplicados en rango copiado
    h2.Range("C7:C" & h2.Range("C" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
'Copiar formato de celda de Fila 7 a Filas 8:26
    h2.Rows("7:7").Copy
    u2 = h2.Range("C" & Rows.Count).End(xlUp).Row
    h2.Rows("7:" & u2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    h2.Select
    Range("B7").Select
    Application.ScreenUpdating = True
    MsgBox "fin"
End Sub

sal u dos

Respuesta
3
Private Sub CommandButton3_Click()
Set h1 = Worksheets("packing")
Set h2 = Worksheets("report")
Set origen = h2.Range("a7").CurrentRegion
Set destino = h1.Range("a7:e26")
With destino
    .ClearContents
    With origen:  .Columns(5).Copy:  End With
    .Columns(3).PasteSpecial xlPasteAllUsingSourceTheme
    .RemoveDuplicates Columns:=3
     Application.CutCopyMode = False
    MsgBox ("COPIA TERMINADA"), vbInformation, "AVISO"
End With
End Sub

prueba con esta macro es mas corta y hace lo mismo 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas