Macro exporte datos a una hoja y elimine

Lic. Dante Amor.

Le envie a su correo archivo de excel sobre la macro que me creo formula exporte datos de una hoja, No especifique que datos necesito copie hasta ciertas celdas NO toda la hoja completa.

Al igual elimine los centros que no requiero de la Hoja1.

Respuesta
2

H o l a :

Te anexo la macro

Sub ExportarDatos()
'Por.Dante AmoR
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    celda = "B1"
    '
    If Range(celda) = "" Then
        MsgBox "Captura el centro en la celda: " & celda
        Range(celda).Select
        Exit Sub
    End If
    '
    h2.Cells.ClearContents
    j = 6
    For i = h1.Range("C" & Rows.Count).End(xlUp).Row To 4 Step -1
        If h1.Cells(i, "C") = h1.[B1] Then
            h1.Range(h1.Cells(i, "C"), h1.Cells(i, "H")).Copy h2.Cells(j, "A")
            j = j + 1
        Else
            h1.Rows(i).Delete
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

':)
':)

buenas noches...

Lic. la macro corre perfectamente, nada mas un detalle en la Hoja2  cuando hace la copia me borra las encabezados de la A1 a P5.

  y tengo mas datos y formulas de la G6 a la P1000  me los borra, me podría ayudar en corregir la macro que nada mas copie de la A6 a la F6  y no borre lo que menciones antes

en espera de sua apoyo

gracias

saludos

Te anexo la macro actualizada

Sub ExportarDatos()
'Por.Dante AmoR
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    celda = "B1"
    '
    If h1.Range(celda) = "" Then
        MsgBox "Captura el centro en la celda: " & celda
        Range(celda).Select
        Exit Sub
    End If
    '
    'h2.Cells.ClearContents
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    If u < 6 Then u = 6
    h2.Range("A6:F" & u).ClearContents
    j = 6
    For i = h1.Range("C" & Rows.Count).End(xlUp).Row To 4 Step -1
        If h1.Cells(i, "C") = h1.[B1] Then
            h1.Range(h1.Cells(i, "C"), h1.Cells(i, "H")).Copy h2.Cells(j, "A")
            j = j + 1
        Else
            h1.Rows(i).Delete
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

':)
':)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas