Anónimo
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
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 SubCabe 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 SubTambién noté que tenia algo mal en el código anterior, ya lo corregí.
Andy