Macro comparar valores columnas y copiar y pegar

Necesito realizar un macro que me compare dos columnas y si estas coinciden que me copie y pegue los valores relacionados en una a la otra, vale aclarar que las dos columnas se encuentran en hojas distintas, el proceso sería algo así:
Tengo dos hojas con diferentes valores:
Hoja1 hoja2
A B C D A B C D
1 C 1.0 2.1 1 C
3 F 0.0 4.2 2 T
4 AA 1.3 3.1 3 F
5 FF 11 12 4 AA
6 TT 34 55 7 EE
7 EE 99 21 8 AS
Yo quiero comparar las columnas A y B de cada hoja, y si coinciden los valores, como es el caso de A, B = (1, C), (3, F), (4, AA) Y (7, EE).
Entonces quiero que luego mi macro me copie los valores relacionados a estos, es decir C y DE de la HOJA 1 a las columnas C y DE de la HOJA 2, quedando algo así:
HOJA1 HOJA2
A B C D A B C D
1 C 1.0 2.1 1 C 1.0 2.1
3 F 0.0 4.2 2 T
4 AA 1.3 3.1 3 F 0.0 4.2
5 FF 11 12 4 AA 1.3 3.1
6 TT 34 55 7 EE 99 21
7 EE 99 21 8 AS
Y que al final en la HOJA 2, me rellene las celdas que quedaron sin valor con ceros "0.0"
Les agradecerpia mucho su valiosa ayuda.

1 Respuesta

Respuesta
1
Este código hace lo que necesitas:
Sub Copia()
Sheets("Hoja1").Select
Dim Comprobar, Contador
Comprobar = True: Contador = 0 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
If Range("A" & Contador).Value <> "" Then ' Si la condición es verdadera.
a = Range("A" & Contador).Value
b = Range("B" & Contador).Value
c = Range("C" & Contador).Value
d = Range("D" & Contador).Value
Sheets("Hoja2").Select
Do ' Bucle externo.
Do While Contador2 < 65000 ' Bucle interno.
Contador2 = Contador2 + 1 ' Incrementa el contador.
If Range("A" & Contador2).Value <> "" Then ' Si la condición es verdadera.
If Range("A" & Contador2).Value = a And Range("B" & Contador2).Value = b Then
Range("C" & Contador2).Value = c
Range("D" & Contador2).Value = d
Else
Range("C" & Contador2).Value = "0.0"
Range("D" & Contador2).Value = "0.0"
End If
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente
Sheets("Hoja1").Select
Else
Comprobar = False ' Establece el valor a False.
Si tienes muchos datos puede que demore un poco.
Hola!
Muchas gracias por tu ayuda, pero he corrido la macro y no me da resultados :'(, solamente me copia y pega los valores del primer valor o la primera comparación que da igual, pero los siguientes no lo hace, solo los coloca en ceros, lo otro es que las columnas donde quiero copiar no son las mismas de la primera es decir, en vez de copiar los valores de las columnas C y DE de la HOJA1, en C y DE de la HOJA2, sería copiar C y DE de la HOJA1 en las columnas E y F de la HOJA2 sería algo así :
HOJA1 HOJA2
A B C D A B C D E F
1 C 1.0 2.1 1 C
3 F 0.0 4.2 2 T
4 AA 1.3 3.1 3 F
5 FF 11 12 4 AA
6 TT 34 55 7 EE
7 EE 99 21 8 AS
HOJA1 HOJA2
A B C D A B C D E F
1 C 1.0 2.1 1 C 1.02.1
3 F 0.0 4.2 2 T
4 AA 1.3 3.1 3 F 0.0 4.2
5 FF 11 12 4 AA 1.33.1
6 TT 34 55 7 EE 9921
7 EE 99 21 8 AS
Estuve tratando de modificar el código para mi caso, pero no me da lo que quiero aún :'(, aquí te copio el código que modifique.
Te agradezco la ayuda que me puedas brindar.
Saludos!
Sub CopiaCompara()
Sheets("PLANT").Select
Dim Comprobar, Contador
Comprobar = True: Contador = 0 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
If Range("A" & Contador).Value <> "" Then ' Si la condición es verdadera.
a = Range("A" & Contador).Value
b = Range("B" & Contador).Value
c = Range("C" & Contador).Value
d = Range("D" & Contador).Value
e = Range("E" & Contador).Value
f = Range("F" & Contador).Value
Sheets("BUS_FINAL").Select
Do ' Bucle externo.
Do While Contador2 < 65000 ' Bucle interno.
Contador2 = Contador2 + 1 ' Incrementa el contador.
If Range("A" & Contador2).Value <> "" Then ' Si la condición es verdadera.
g = Range("G" & Contador2).Value
h = Range("H" & Contador2).Value
i = Range("I" & Contador2).Value
j = Range("J" & Contador2).Value
If Range("A" & Contador2).Value = a And Range("B" & Contador2).Value = b Then
Range("G" & Contador2).Value = c
Range("H" & Contador2).Value = d
Range("I" & Contador2).Value = e
Range("J" & Contador2).Value = f
Else
Range("G" & Contador2).Value = "0.0"
Range("H" & Contador2).Value = "0.0"
Range("I" & Contador2).Value = "0.0"
Range("J" & Contador2).Value = "0.0"
End If
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente
Sheets("PLANT").Select
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente
End Sub
Este código resuelve la primera parte del problema,
Sub Copia()
Sheets("Hoja1").Select
Dim Comprobar, Contador
Comprobar = True: Contador = 0 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
If Range("A" & Contador).Value <> "" Then ' Si la condición es verdadera.
a = Range("A" & Contador).Value
b = Range("B" & Contador).Value
c = Range("C" & Contador).Value
d = Range("D" & Contador).Value
Sheets("Hoja2").Select
Do ' Bucle externo.
Do While Contador2 < 65000 ' Bucle interno.
Contador2 = Contador2 + 1 ' Incrementa el contador.
If Range("A" & Contador2).Value <> "" Then ' Si la condición es verdadera.
If Range("A" & Contador2).Value = "" Or Range("A" & Contador2).Value = "0.0" Then
If Range("A" & Contador2).Value = a And Range("B" & Contador2).Value = b Then
Range("C" & Contador2).Value = c
Range("D" & Contador2).Value = d
Else
Range("C" & Contador2).Value = "0.0"
Range("D" & Contador2).Value = "0.0"
End If
End If
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente
Sheets("Hoja1").Select
Pruebe y me avisas, para ir resolviendo el resto de lo que necesitas.
Hola muchas gracias por tu ayuda, ya corrí el programa, pero no me sale nada :(, según lo que vi por ahora solo está comparando, ¿más no ha empezado a copiar y pegar cierto?
Ok, mi error no lo había probado,
Prueba ahora:
Sub Copia()
Sheets("Hoja1").Select
Dim Comprobar, Contador
Comprobar = True: Contador = 0 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
If Range("A" & Contador).Value <> "" Then ' Si la condición es verdadera.
a = Range("A" & Contador).Value
b = Range("B" & Contador).Value
c = Range("C" & Contador).Value
d = Range("D" & Contador).Value
Sheets("Hoja2").Select
Do ' Bucle externo.
Do While contador2 < 65000 ' Bucle interno.
contador2 = contador2 + 1 ' Incrementa el contador.
If Range("A" & contador2).Value <> "" Then ' Si la condición es verdadera.
If Range("C" & contador2).Value = "" Or Range("C" & contador2).Value = "0.0" Then
If Range("A" & contador2).Value = a And Range("B" & contador2).Value = b Then
Range("C" & contador2).Value = c
Range("D" & contador2).Value = d
Else
Range("C" & contador2).Value = "0.0"
Range("D" & contador2).Value = "0.0"
End If
End If
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
contador2 = 0
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente
Sheets("Hoja1").Select

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas