Macro comparar dos columnas en diferentes hojas, luego copiar y pegar

19/09/2011 - 09:11 por xigora9 | Informe spam

Hola!!!
He tratado de realizar el siguiente proceso en una macro en excel pero aun no obtengo resultados :'( :

Tengo dos hojas, con las siguientes descripciones:

HOJA1: Valores en las columnas "A", "B", "C", "D", "E", y "F"

HOJA2: Valores en las columnas "A" y "B", columnas vacías en "G", "H", "I" y "J"

Quiero comparar en las dos hojas, las columnas "A" y "B", y en el caso de que estos valores coincidan, entonces que se copien de la HOJA1 los valores de las columnas "C", "D", "E", y "F", en la HOJA 2, en las columnas "G", "H", "I" y "J". Y las celdas en donde no coincidan las llene de ceros.

Un ejemplo sería algo como asi:

HOJA1 ________________HOJA2

A_B_C_D_E_F___A_B_C_D_E_F_G_H_I_J
1_C_1 _2_1_1 ___2_H
3_F__0_4_2_2___4_A
4_A_1__3_3_1___5_F
5_F_1__1_4_3___7_E
6_T_3__5_7_6___8_U
7_E_9__2_8_A___9_L

HOJA1 ________________HOJA2

A_B_C_D_E_F___A_B_C_D_E_F_G__H_I_J
1_C_1 _2_1_1 ___2_H
3_F__0_4_2_2___4_A__________1__3_3_1
4_A_1__3_3_1___5_F__________1__1_4_3
5_F_1__1_4_3___7_E__________9__2_8_A
6_T_3__5_7_6___8_U
7_E_9__2_8_A___9_L

Les agradezco la ayuda que me pudieran brindar.

La macro que llevo hasta ahora, sin ningún resultado :'( , es la siguiente:

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.
a2 = Range("A" & Contador2).Value
b2 = Range("B" & Contador2).Value
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

Siga el debate

1 respuesta

Tengo una respuesta

Preguntas similare

macro para comparar dos hojas de calculo (99columnas y 7000filas)

Leer las respuestas

#1 Aladino

22/09/2011 - 13:48 | Informe spam

Hola,

Puedes probar esta:

Sub Comcop()
'Define el diseño de la hoja 1
Const sheet1Name = "Hoja1"
Const s1FirstDataRow = 1
Const s1MstrCol1 = "A"
Const s1MstrCol2 = "B"
Const s1DataCol1 = "C"
Const s1DataCol2 = "D"
Const s1DataCol3 = "E"
Const s1DataCol4 = "F"
'Define el diseño de la hoja 2
Const sheet2Name = "Hoja2"
Const s2FirstDataRow = 1
Const s2MstrCol1 = "A"
Const s2MstrCol2 = "B"
Const s2DataCol1 = "G"
Const s2DataCol2 = "H"
Const s2DataCol3 = "I"
Const s2DataCol4 = "J"

'variables a tener en cuenta
Dim ws1 As Worksheet
Dim s1LastRow As Long
Dim s1MasterList As Range
Dim anyS1ListEntry As Range
Dim offsetToS1MC2 As Integer 'Se mueve de A a B

Dim ws2 As Worksheet
Dim s2LastRow As Long
Dim s2MasterList As Range
Dim anyS2ListEntry As Range
Dim offsetToS2MC2 As Integer ' Se mueve de A a B

Set ws1 = ThisWorkbook.Worksheets(sheet1Name)
s1LastRow = ws1.Range(s1MstrCol1 & Rows.Count).End(xlUp).Row
Set s1MasterList = ws1.Range(s1MstrCol1 & s1FirstDataRow & _
":" & s1MstrCol1 & s1LastRow)
offsetToS1MC2 = Range(s1MstrCol2 & 1).Column - Range(s1MstrCol1 &
1).Column

Set ws2 = ThisWorkbook.Worksheets(sheet2Name)
s2LastRow = ws1.Range(s2MstrCol1 & Rows.Count).End(xlUp).Row
Set s2MasterList = ws2.Range(s2MstrCol1 & s2FirstDataRow & _
":" & s2MstrCol1 & s2LastRow)
offsetToS2MC2 = Range(s2MstrCol2 & 1).Column - Range(s2MstrCol1 &
1).Column
Application.ScreenUpdating = False
For Each anyS2ListEntry In s2MasterList
For Each anyS1ListEntry In s1MasterList
If anyS2ListEntry = anyS1ListEntry And _
anyS2ListEntry.Offset(0, offsetToS2MC2) = _
anyS1ListEntry.Offset(0, offsetToS1MC2) Then
ws2.Range(s2DataCol1 & anyS2ListEntry.Row) = _
ws1.Range(s1DataCol1 & anyS1ListEntry.Row)
ws2.Range(s2DataCol2 & anyS2ListEntry.Row) = _
ws1.Range(s1DataCol2 & anyS1ListEntry.Row)
ws2.Range(s2DataCol3 & anyS2ListEntry.Row) = _
ws1.Range(s1DataCol3 & anyS1ListEntry.Row)
ws2.Range(s2DataCol4 & anyS2ListEntry.Row) = _
ws1.Range(s1DataCol4 & anyS1ListEntry.Row)
Exit For ' Sale del Loop
End If
Next ' Finaliza el Loop anyS1ListEntry
Next ' Finaliza el Loop anyS2ListEntry

'Mantenimiento
Set s1MasterList = Nothing
Set ws1 = Nothing
Set s2MasterList = Nothing
Set ws2 = Nothing
End Sub

Siga el debate Respuesta

Responder a este mensaje

Ads by Google

Hacer una pregunta

Tengo una respuesta

Busqueda sugerida