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
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