Amélioration de code VBA

  • Initiateur de la discussion Quaisako
  • Date de début
Q

Quaisako

Guest
Bonjour à toutes et à tous,

Le code ci-dessous me permet de copier des données du classeur
"Basket" dans le classeur "Recap".

J'ai le même code pour d'autres classeurs: "Football", "Danse", "Tennis de table".........................

Ca fonctionne sans problème, mais j'aimerai que:

au lieu de copier directement les données, il y ai une vérification des
données déjà écrites dans le classeur "Recap", et que la copie se fasse
uniquement s'il y a un changement.

Merci d'avance pour vos idées et solutions.

Jipé


Sub zaza()
Dim Critere As String
Critere = "BASKET"

Application.ScreenUpdating = False
Set tbl = Range("A5").CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
Selection.Copy
Range("A6").Select

On Error Resume Next
Workbooks("Recap.xls").Activate
If Err <> 0 Then
Err = 0
fichier = "C:\WINDOWS\Bureau\OmniSport\Recap.xls"
Workbooks.Open Filename:=fichier

If Err <> 0 Then
MsgBox "Le fichier '" & fichier & "' est introuvable"
Exit Sub
End If
End If

Workbooks("Recap.xls").Worksheets("Detail").Activate

x = ActiveSheet.UsedRange.Rows.Count
For Z = (x + 6) To 6 Step -1
If Cells(Z, 1) = Critere Then Rows(Z).Delete Shift:=xlUp
Next Z

[A65536].End(xlUp)(2).Activate

ActiveSheet.Paste

Y = ActiveSheet.UsedRange.Rows.Count
Range("A6:S" & Y + 4).Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending,
Key2:=Range("C6"), Order2:=xlAscending, header:=xlGuess, OrderCustom:=1
Range("A6").Select

ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub
 

Statistiques des forums

Discussions
314 656
Messages
2 111 608
Membres
111 218
dernier inscrit
Jean-Kev