Bonjour,
J'ai essayé de trouver une solution dans les nombreux messages qui ont le même titre sur ce forum mais je suis toujours bloqué ! ;(
C'est un ensemble de 2 macros (récupéré ici Compare two worksheet ranges using VBA in Microsoft Excel).
Ces deux macros me permettent de trouver si il y a des différences dans les cellules de deux colonnes situées dans deux onglets différents.
nb: Je n'ai modifié que la deuxième macro ci-dessous.
La ligne suivante est celle qui pose problème :
With Sheets(i)
Ce que je trouve bizarre c'est que la macro fonctionne si je supprime les lignes suivantes :
Dim i As Variant
For i = 2 To Sheets.Count
et si je remplace :
With Sheets(i) par With Sheets(2)
With Sheets(i + 1) par With Sheets(3)
Merci d'avance 😉
J'ai essayé de trouver une solution dans les nombreux messages qui ont le même titre sur ce forum mais je suis toujours bloqué ! ;(
C'est un ensemble de 2 macros (récupéré ici Compare two worksheet ranges using VBA in Microsoft Excel).
Ces deux macros me permettent de trouver si il y a des différences dans les cellules de deux colonnes situées dans deux onglets différents.
nb: Je n'ai modifié que la deuxième macro ci-dessous.
Code:
Sub CompareWorksheetRanges(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
If rng1 Is Nothing Or rng2 Is Nothing Then Exit Sub
If rng1.Areas.Count > 1 Or rng2.Areas.Count > 1 Then
MsgBox "Can't compare multiple selections!", _
vbExclamation, "Compare Worksheet Ranges"
Exit Sub
End If
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Set rptWB = Workbooks.Add
Application.DisplayAlerts = False
While Worksheets.Count > 1
Worksheets(2).Delete
Wend
Application.DisplayAlerts = True
With rng1
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With rng2
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
If maxR < lr2 Then maxR = lr2
If maxC < lc2 Then maxC = lc2
If lr1 <> lr2 Or lc1 <> lc2 Then
If MsgBox("The two ranges you want to compare are of different size!" & _
Chr(13) & "Do you want to continue anyway?", _
vbQuestion + vbYesNo, "Compare Worksheet Ranges") = vbNo Then Exit Sub
End If
DiffCount = 0
For c = 1 To maxC
Application.StatusBar = "Comparing cells " & _
Format(c / maxC, "0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = rng1.Cells(r, c).FormulaLocal
cf2 = rng2.Cells(r, c).FormulaLocal
On Error GoTo 0
If cf1 <> cf2 Then
DiffCount = DiffCount + 1
Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
End If
Next r
Next c
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(maxR, maxC))
.Interior.ColorIndex = 19
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error Resume Next
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error GoTo 0
End With
Columns("A:IV").ColumnWidth = 20
rptWB.Saved = True
If DiffCount = 0 Then
rptWB.Close False
End If
Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different formulas!", _
vbInformation, "Compare Worksheet Ranges"
End Sub
Code:
Sub zz01()
Dim Sh1LastRow As Variant
Dim Sh2LastRow As Variant
Dim i As Variant
For i = 2 To Sheets.Count
'With Worksheets(i)
With Sheets(i)
Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
End With
With Sheets(i + 1)
Sh2LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
End With
[B]' compare two ranges in two different worksheets in the active workbook[/B]
CompareWorksheetRanges Worksheets(i).Range("A1:A" & Sh1LastRow), Worksheets(i + 1).Range("A1:A" & Sh2LastRow)
Next i
End SubLa ligne suivante est celle qui pose problème :
With Sheets(i)
Ce que je trouve bizarre c'est que la macro fonctionne si je supprime les lignes suivantes :
Dim i As Variant
For i = 2 To Sheets.Count
et si je remplace :
With Sheets(i) par With Sheets(2)
With Sheets(i + 1) par With Sheets(3)
Merci d'avance 😉
Dernière édition:
