compara dos hojas de diferentes libros de excel, crea otro libro y muestrame uno marcando las difere

[komandanteiceman]

hola estoy siguiendo la ayuda de varios de vuestros foros en concreto:

https://www.ayudaexcel.com/foro/varios-11/solucionado-comparar-dos-archivos-excel-generar-otro-diferencias-11898/

tengo que conseguir:

1 que me compare dos hojas de diferentes excels que se encuentran en una carpeta de mi ordenador (CONSEGUIDO0)

2 que me marque las diferencias en el excel mas actual (conseguido)

problema:

cuando empieza a comparar y marcar se me para en una fila concreta y no continua.

si alguien me puede ayudar os pasaría los excels y la macro que tengo echa para que me la revisarais.

Estaría eternamente agradecido, mi trabajo depende de ello y debo entregarlo para el lunes.

[Antoni]

Re: compara dos hojas de diferentes libros de excel, crea otro libro y muestrame uno marcando las diferen

Lo siento, pero sin tu archivo no hay nada que hacer.

Sube el archivo, aunque sea sin datos.

[Antoni]

Re: compara dos hojas de diferentes libros de excel, crea otro libro y muestrame uno marcando las diferen

Las hojas que intentas comparar contienen vínculos a otros libros y creo, solo creo, que por ahí vienen los problemas.

Esto es lo máximo que se puede hacer, y recuerda que no está permitido en el foro personalizar las consultas.

Sub Comparar()


Dim A, B, C As Worksheet

On Error Resume Next


Application.ScreenUpdating = False


Workbooks.Open "C:\Users\ICEMAN\Desktop\Nueva carpeta\NEW.xlsx"

Workbooks.Open "C:\Users\ICEMAN\Desktop\Nueva carpeta\OLD.xlsx"

Workbooks.Open "C:\Users\ICEMAN\Desktop\Nueva carpeta\prueba.xlsx"


Set B = Workbooks("OLD.xlsx").Sheets("Roadmap Opportunity List")

Set A = Workbooks("NEW.xlsx").Sheets("Roadmap Opportunity List")

Set C = Workbooks("prueba.xlsx").Sheets(1)


C.Cells.ClearContents

C.Activate


[COLOR=#0000cd][B]A.Cells.Copy: A.Cells.PasteSpecial Paste:=xlValues[/B]

[B]B.Cells.Copy: B.Cells.PasteSpecial Paste:=xlValues[/B][/COLOR]


A.Rows([COLOR=#0000cd][B]35[/B][/COLOR]).Copy C.Rows(1)

Z = 1

For x = [COLOR=#0000cd][B]36 [/B][/COLOR]To [COLOR=#0000cd][B]A.Range("G" & Rows.Count).End(xlUp).Row[/B][/COLOR]

  PrimerError = False

  For y = 1 To [COLOR=#0000cd][B]40[/B][/COLOR]

    If A.Cells(x, y) <> B.Cells(x, y) Then

        If PrimerError = False Then

            PrimerError = True

            Z = Z + 1

            A.Rows(x).Copy C.Rows(Z)

        End If

        C.Cells(Z, y).Font.Color = vbRed

        C.Cells(Z, y).Font.Bold = True

    Else

        If PrimerError = False Then

            PrimerError = True

            Z = Z + 1

            A.Rows(x).Copy C.Rows(Z)

            C.Cells(Z, y).Font.Color = vbBlack

            C.Cells(Z, y).Font.Bold = False

        End If

        End If

  Next y

Next x


End Sub

[/CODE]