Macro para Copiar de un libro a otro

Tengo 2 libros de excel, en el libro2 en hoja1 la columna A y G contienen nombres y claves respectivamente.
En el libro 1 en hoja1 en la columna A contiene los mismos nombres del libro2 pero en diferente orden.
Quisiera agregar las claves del libro2 al libro1 en la columna F, pero no se como hacerlo con una macro de tal manera que coincidan.

Agrego un ejemplo del Libro 2, solo que el real tiene muchísimas filas y hay celdas vacías:

Libro1

1 Respuesta

Respuesta
1

Basado en el ejemplo de las imágenes, este podría ser un código funcional:

Nota: Debes tener ambos libros abiertos al mismo tiempo.

Sub passClaves()
Dim libro1 As Workbook: Set libro1 = Workbooks("Libro1.xls")
Dim libro2 As Workbook: Set libro2 = ThisWorkbook
Dim hojaL1 As Worksheet: Set hojaL1 = libro1.Sheets("Sheet1")
Dim hojaL2 As Worksheet: Set hojaL2 = libro2.Sheets("Sheet1")
Dim uF1 As Long, uF2 As Long
uF1 = hojaL1.Range("A" & Rows.Count).End(xlUp).Row
uF2 = hojaL2.Range("A" & Rows.Count).End(xlUp).Row
Dim nombre1 As Range, nombre2 As Range
Dim Nombres1 As Range: Set Nombres1 = hojaL1.Range("A2:A" & uF2)
Dim Nombres2 As Range: Set Nombres2 = hojaL2.Range("A2:A" & uF2)
For Each nombre2 In Nombres2.Cells
    If Not IsEmpty(nombre2) Then
        With Nombres1
            Set nombre1 = .Find(What:=nombre2.Value, _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not nombre1 Is Nothing Then
                hojaL1.Cells(nombre1.Row, 6).Value = hojaL2.Cells(nombre2.Row, 7).Value
            End If
        End With
    End If
Next nombre2
End Sub

Cabe destacar que si dos personas se llaman igual, puede haber conflicto. El rendimiento de este método dependerá de cuan grande sea el registro (cuantas filas hay)

Debes modificar los nombres de los libros, hojas y rangos en el código a la hora de adaptarlo a tu caso real.

Ah, la macro debe ir en el libro2, en un modulo estándar.

Hola! Antes que nada muchas gracias por tu pronta respuesta.

te comento que la macro si funcionó, hice los cambios correspondientes pero lo que pasa es que si se repiten los nombres varias veces  entonces deberia de copiar la misma clave, la columna es de 3000 filas con nombres repetidos, y la macro solo copia algunos y otros no.

me puedes ayudar para corregir ese detalle, por favor!

Hello, disculpa la demora. He modificado el código, prueba este:

Sub passClaves()
Dim libro1 As Workbook: Set libro1 = Workbooks("Libro1.xls")
Dim libro2 As Workbook: Set libro2 = ThisWorkbook
Dim hojaL1 As Worksheet: Set hojaL1 = libro1.Sheets("Sheet1")
Dim hojaL2 As Worksheet: Set hojaL2 = libro2.Sheets("Sheet1")
Dim uF1 As Long, uF2 As Long
uF1 = hojaL1.Range("A" & Rows.Count).End(xlUp).Row
uF2 = hojaL2.Range("A" & Rows.Count).End(xlUp).Row
Dim nombre1 As Range, nombre2 As Range
Dim nombre1Adr As String
Dim Nombres1 As Range: Set Nombres1 = hojaL1.Range("A2:A" & uF1)
Dim Nombres2 As Range: Set Nombres2 = hojaL2.Range("A2:A" & uF2)
For Each nombre2 In Nombres2.Cells
    If Not IsEmpty(nombre2) Then
        With Nombres1
            Set nombre1 = .Find(What:=nombre2.Value)
            If Not nombre1 Is Nothing Then
            nombre1Adr = nombre1.Address
                Do
                    hojaL1.Cells(nombre1.Row, 6).Value = hojaL2.Cells(nombre2.Row, 7).Value
                    Set nombre1 = .FindNext(nombre1)
                Loop While Not nombre1 Is Nothing And nombre1.Address <> nombre1Adr
            End If
        End With
    End If
Next nombre2
End Sub

También noté que tenia algo mal en el código anterior, ya lo corregí.

Andy

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas