Macro para copiar ciertas celdas en otro excel y en otra hoja que se auto-complete

¿Cómo están? Bueno tengo las siguientes macros por separados

Sub CopiarCeldas()
'Definir objetos a utilizar
Dim wbDestino As Workbook, _
wsOrigen As Excel.Worksheet, _
wsDestino As Excel.Worksheet, _
rngOrigen As Excel.Range, _
rngDestino As Excel.Range
'Indicar el libro de Excel destino
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "\Historico Fallas.xlsx")
'Activar este libro
ThisWorkbook.Activate
'Indicar las hojas de origen y destino
Set wsOrigen = Worksheets("Perdidas")
Set wsDestino = wbDestino.Worksheets("Respaldo")
'Indicar la celda de origen y destino
Const celdaOrigen = "A11"
u = wsDestino.Range("A" & Rows.Count).End(xlUp).Row + 1
'Const celdaDestino = "A" & u
celdaDestino = "A" & u
'Inicializar los rangos de origen y destino
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
'Seleccionar rango de celdas origen
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Pegar datos en celda destino
rngDestino.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Guardar y cerrar el libro de Excel destino
wbDestino.Save
wbDestino.Close
End Sub

La cual me sirve para copiar cierto numero de celdas en otro excel pero ahora necesito pegar estas

Range("e4").Copy Destination:=Worksheets("Analisis L1").Range("A4")
Range("e6").Copy Destination:=Worksheets("Analisis L1").Range("e4")
Range("e7").Copy Destination:=Worksheets("Analisis L1").Range("b4")
End Sub

Lo que quiero es que me copie solo las ultimas 3 celdas en el excel nuevo que se guarde y se cierre, no se si me entienden si me explique bien o no. Quiero combinar las macros.

1 respuesta

Respuesta
1

Te cambio la macro

Sub CopiarCeldas()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Perdidas")
    Set l2 = Workbooks.Open(ActiveWorkbook.Path & "\Historico Fallas.xlsx")
    Set h2 = l2.Sheets("Respaldo")
    Set h3 = l2.Sheets("Analisis L1")
    '
    u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
    h1.[A11].CurrentRegion.Copy h2.Range("A" & u)
    '
    h1.Range("E4").Copy h3.Range("A4")
    h1.Range("E6").Copy h3.Range("E4")
    h1.Range("E7").Copy h3.Range("B4")
    'Guardar y cerrar el libro de Excel destino
    l2.Close True
End Sub

Prueba el funcionamiento y me comentas.

Saludos. Dante Amor

Si es lo que necesitas.

Hola buenas lamento decirte que no es lo que quería, pero no por tu culpa si no porque yo lo pedí mal, lo que quiero es que la macro me copie las siguientes celdas del libro "reporte de fallas", de la hoja "perdidas" y que las pegue en el libro "histórico falas" a la hoja "analisis" dependiendo de las siguientes celdas.

E5 a A2 

E4 a B2

E6 a C2 

E7 a D2 

Y eso por ahora porque hay más celdas pero una ves que capte la lógica lo podre modificar a mi necesidad :),

PD: la macro de arriba me abrió y guardo el libro tal cual como quería.

Te anexo la macro

Sub CopiarCeldas()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Perdidas")
    Set l2 = Workbooks.Open(ActiveWorkbook.Path & "\Historico Fallas.xlsx")
    Set h2 = l2.Sheets("Respaldo")
    Set h3 = l2.Sheets("Analisis")
    '
    h1.[E5].Copy h3.Range("A2")
    h1.[E4].Copy h3.Range("B2")
    h1.[E6].Copy h3.Range("C2")
    h1.[E7].Copy h3.Range("D2")
    'Guardar y cerrar el libro de Excel destino
    l2.Close True
End Sub

Pero supongo que quieres copiar las celdas a la última fila de la hoja "analisis", entonces sería con esta macro:

Sub CopiarCeldas()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Perdidas")
    Set l2 = Workbooks.Open(ActiveWorkbook.Path & "\Historico Fallas.xlsx")
    Set h3 = l2.Sheets("Analisis")
    '
    u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
    h1.[E5].Copy h3.Range("A" & u)
    h1.[E4].Copy h3.Range("B" & u)
    h1.[E6].Copy h3.Range("C" & u)
    h1.[E7].Copy h3.Range("D" & u)
    'Guardar y cerrar el libro de Excel destino
    l2.Close True
End Sub

Saludos.Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas