Bonjour à tous,
je cherche de l'aide pour améliorer la macro qui suit
je dois détecter les doublons dans divers fichiers que j e place dans un seul classeur
je dois l’enregistrer pour garder trace de ce contrôle
j’aimerai insérer des boutons d'actions sur la feuille deux du fichier et retrouver la synthèse en feuille 1 ou l'inverse
merci d'avance pour votre aide
ci desous le code en question
Private Sub CommandButton1_Click()
' Boucle sur chaque Feuille (Sauf la première qui est Synthese)
For i = 3 To Sheets.Count
Sheets(i).AutoFilterMode = False ' Suppression de tyout Filtre
Sheets(i).Rows("5:5").AutoFilter Field:=1, Criteria1:="<>" ' Filtre sur la première colonne différent de vide
Sheets(i).Rows("1:" & Sheets(i).Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy 'Copie
LigneCollage = Sheets("Synthese").Range("A" & Rows.Count).End(xlUp).Row + 0 'Rechercher de la ligne de collage
If LigneCollage < 1 Then LigneCollage = 1
Sheets("Synthese").Range("A" & LigneCollage).PasteSpecial 'Collage
Application.CutCopyMode = False
Sheets(i).AutoFilterMode = False ' Suppression de tout Filtre
Next i
End Sub
Private Sub CommandButton2_Click()
Dim i As Integer
For i = [A65000].End(xlUp).Row To 1 Step -1
If Not Cells(i, 1).Find("Total") Is Nothing Or _
Not Cells(i, 1).Find("Dénomination Professionnel") Is Nothing Or _
Not Cells(i, 1).Find("test") Is Nothing Then Rows(i).Delete
Next i
End Sub
Private Sub CommandButton3_Click()
'ConcatColumns
For i = 1 To 10
Cells(1, 11) = Cells(1, 11) & "" & Cells(1, i)
Next i
End Sub
Sub Macro1()
Selection.AutoFill Destination:=ActiveCell.Range("A1:A182")
ActiveCell.Range("A1:A182").Select
End Sub
Sub RechercherDoublons()
Dim col, nbCells, i, j
col = ActiveCell.Column
nbCells = Application.WorksheetFunction.CountA(Range(Columns(col), Columns(col)))
For i = 1 To nbCells - 1
For j = i + 1 To nbCells
If Cells(i, col) = Cells(j, col) Then
Cells(j, col).Interior.Color = RGB(255, 0, 0)
End If
Next j
Next i
End Sub
Private Sub Macro5_Click()
'
'
ActiveCell.FormulaR1C1 = "=+IF(COUNTIF(C[-1],RC[-1])>1,""doublon"",""ras"")"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A182")
ActiveCell.Range("A1:A182").Select
ActiveCell.Select
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$182").AutoFilter Field:=12, Criteria1:= _
"=doublon", Operator:=xlAnd
End Sub
Sub sauvegarder()
ChDir "h:\Dossier\"
ActiveWorkbook.SaveAs Filename:=Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
End Sub
je cherche de l'aide pour améliorer la macro qui suit
je dois détecter les doublons dans divers fichiers que j e place dans un seul classeur
je dois l’enregistrer pour garder trace de ce contrôle
j’aimerai insérer des boutons d'actions sur la feuille deux du fichier et retrouver la synthèse en feuille 1 ou l'inverse
merci d'avance pour votre aide
ci desous le code en question
Private Sub CommandButton1_Click()
' Boucle sur chaque Feuille (Sauf la première qui est Synthese)
For i = 3 To Sheets.Count
Sheets(i).AutoFilterMode = False ' Suppression de tyout Filtre
Sheets(i).Rows("5:5").AutoFilter Field:=1, Criteria1:="<>" ' Filtre sur la première colonne différent de vide
Sheets(i).Rows("1:" & Sheets(i).Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy 'Copie
LigneCollage = Sheets("Synthese").Range("A" & Rows.Count).End(xlUp).Row + 0 'Rechercher de la ligne de collage
If LigneCollage < 1 Then LigneCollage = 1
Sheets("Synthese").Range("A" & LigneCollage).PasteSpecial 'Collage
Application.CutCopyMode = False
Sheets(i).AutoFilterMode = False ' Suppression de tout Filtre
Next i
End Sub
Private Sub CommandButton2_Click()
Dim i As Integer
For i = [A65000].End(xlUp).Row To 1 Step -1
If Not Cells(i, 1).Find("Total") Is Nothing Or _
Not Cells(i, 1).Find("Dénomination Professionnel") Is Nothing Or _
Not Cells(i, 1).Find("test") Is Nothing Then Rows(i).Delete
Next i
End Sub
Private Sub CommandButton3_Click()
'ConcatColumns
For i = 1 To 10
Cells(1, 11) = Cells(1, 11) & "" & Cells(1, i)
Next i
End Sub
Sub Macro1()
Selection.AutoFill Destination:=ActiveCell.Range("A1:A182")
ActiveCell.Range("A1:A182").Select
End Sub
Sub RechercherDoublons()
Dim col, nbCells, i, j
col = ActiveCell.Column
nbCells = Application.WorksheetFunction.CountA(Range(Columns(col), Columns(col)))
For i = 1 To nbCells - 1
For j = i + 1 To nbCells
If Cells(i, col) = Cells(j, col) Then
Cells(j, col).Interior.Color = RGB(255, 0, 0)
End If
Next j
Next i
End Sub
Private Sub Macro5_Click()
'
'
ActiveCell.FormulaR1C1 = "=+IF(COUNTIF(C[-1],RC[-1])>1,""doublon"",""ras"")"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A182")
ActiveCell.Range("A1:A182").Select
ActiveCell.Select
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$182").AutoFilter Field:=12, Criteria1:= _
"=doublon", Operator:=xlAnd
End Sub
Sub sauvegarder()
ChDir "h:\Dossier\"
ActiveWorkbook.SaveAs Filename:=Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
End Sub