Base de donnée excel avec VBA

[melek]

J’ai une base de donnée qui gère le classement des athlètes et clubs en pêche à la ligne bord de mer mais le problème qu’a chaque fois que j’exécute un macro j’ai un message d’erreur « votre classeur est plein de formules » suivi du message Windows a trouver une erreur le système va se déconnecter en faite ma base est constituée de trois modules et plusieure feuilles en plus des formules
‘Module 1 de la base
‘Qui sert à filtré et extraire des enregistrements de la feuille « CLASSJ1 » classement des athlètes première journée . Et les mettre dans une feuille intermédiaire « CALCUL1 » pour faire des calcules et après ils seront transmis à la feuille « CLASSCLUB » classement des clubs
Sub ExtraitVersAutreFeuille()
'filtre club 1
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("X1:X2"), _
CopyToRange:=Sheets("CALCUL1").Range("B11"), Unique:=False
Columns("B:B").EntireColumn.AutoFit
'filtre club 2
Sheets("CLASSJ1").Range("A1171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("Y1:Y2"), _
CopyToRange:=Sheets("CALCUL1").Range("F1:H1"), Unique:=False
Columns("F:F").EntireColumn.AutoFit
'filtre club 3
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("Z1:Z2"), _
CopyToRange:=Sheets("CALCUL1").Range("J1:L1"), Unique:=False
Columns("J:J").EntireColumn.AutoFit
'filtre club 4
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AA1:AA2"), _
CopyToRange:=Sheets("CALCUL1").Range("N11"), Unique:=False
Columns("N:N").EntireColumn.AutoFit
'filtre club 5
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AB1:AB2"), _
CopyToRange:=Sheets("CALCUL1").Range("R1:T1"), Unique:=False
Columns("R:R").EntireColumn.AutoFit
'filtre club 6
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AC1:AC2"), _
CopyToRange:=Sheets("CALCUL1").Range("V1:X1"), Unique:=False
Columns("V:V").EntireColumn.AutoFit
'filtre club 7
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AD1:AD2"), _
CopyToRange:=Sheets("CALCUL1").Range("Z1:AB1"), Unique:=False
Columns("Z:Z").EntireColumn.AutoFit
'filtre club 8
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AE1:AE2"), _
CopyToRange:=Sheets("CALCUL1").Range("AD1:AF1"), Unique:=False
Columns("AD:AD").EntireColumn.AutoFit
'filtre club 9
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AF1:AF2"), _
CopyToRange:=Sheets("CALCUL1").Range("AH1:AJ1"), Unique:=False
Columns("AH:AH").EntireColumn.AutoFit
'filtre club 10
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AG1:AG2"), _
CopyToRange:=Sheets("CALCUL1").Range("AL1:AN1"), Unique:=False
Columns("AL:AL").EntireColumn.AutoFit
'filtre club 11
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AH1:AH2"), _
CopyToRange:=Sheets("CALCUL1").Range("AP1:AR1"), Unique:=False
Columns("AP:AP").EntireColumn.AutoFit
'filtre club 12
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AI1:AI2"), _
CopyToRange:=Sheets("CALCUL1").Range("AT1:AV1"), Unique:=False
Columns("AT:AT").EntireColumn.AutoFit
'filtre club 13
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AJ1:AJ2"), _
CopyToRange:=Sheets("CALCUL1").Range("AX1:AZ1"), Unique:=False
Columns("AX:AX").EntireColumn.AutoFit
'filtre club 14
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AK1:AK2"), _
CopyToRange:=Sheets("CALCUL1").Range("BB1:BD1"), Unique:=False
Columns("BB:BB").EntireColumn.AutoFit
'filtre club 15
Sheets("CLASSJ1").Range("A1:O171").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("CLASSJ1").Range("AL1:AL2"), _
CopyToRange:=Sheets("CALCUL1").Range("BF1:BH1"), Unique:=False
Columns("BF:BF").EntireColumn.AutoFit

'
'copie des points de la journée 1

Sheets("CLUB").Select
Range("B2:B16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSCLUB").Select
Range("B6:B20").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

' copie des resultats
Sheets("CALCUL1").Select
Range("BJ2:BL15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSCLUB").Select
Range("R6:T20").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

'
' Tri suivant les points places
With Sheets("CLASSCLUB")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("U6:U20"), SortOn:=xlSortOnValues, Order:=xlAcending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("R6:R20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B6:AG19")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub

Module 2
Ce module sert à envoyer les données enregistrées dans la feuille « PESEE » vers les feuilles éventuelles « POISSONi » . Qui fonctionne parfaitement
Sub effacepesee()
'
' vide la pesee en cour
'
Sheets("PESEE").Select
Range("D9").Select
Selection.ClearContents
Range("B13:B19").Select
Selection.ClearContents


End Sub

Sub envoipesee()
'
' envoi les pesees sur l'équipe/secteur

If Sheets("PESEE").OptionButton1.Value = True Then
choix_journee = 1
ElseIf Sheets("PESEE").OptionButton2.Value = True Then
choix_journee = 2
ElseIf Sheets("PESEE").OptionButton3.Value = True Then
choix_journee = 3
ElseIf Sheets("PESEE").OptionButton4.Value = True Then
choix_journee = 4
ElseIf Sheets("PESEE").OptionButton5.Value = True Then
choix_journee = 5
Else
choix_journee = 0
End If

i = 14
J = 2

Range("B13").Select
eq = ActiveCell.Value
Do While eq >= 1
Sheets("POISSON" & choix_journee).Select
Cells(eq + 1, 1).Select
ActiveCell.Value = eq
eq = eq + 1
Do Until i = 20
Sheets("PESEE").Select
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("POISSON" & choix_journee).Select
Cells(eq, J).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
i = i + 1
J = J + 1
Loop
Sheets("PESEE").Select
Cells(11, 7).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("POISSON" & choix_journee).Select
Cells(eq, 19).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

i = i + 1
J = J + 1
effacepesee
eq = 0

Loop
End Sub

Module 3
Ce module exécute le classement des athlètes par journée (copier les données stokes dans les feuilles « INSCRIPTION » et « POISSONi » vers la feuille « CLASSJi » et le classement général après i journées : i=2 à 6 en se basant sur les donnée des feuille « JOURNEEi » et la feuille « INSC »
Sub pagepesee()
'
' Aller page pesee
Sheets("PESEE").Select
End Sub
Sub pagemenu()
'
' Aller page menu
'
Sheets("MENU").Select
End Sub
Sub ClassJ1()
'
' trier 1er journée
' copie des donnees
Sheets("INSCRIPTION").Select
Range("A2:E142").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ1").Select
Range("B2:F142").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON1").Select
Range("B2:F142").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ1").Select
Range("G2:K142").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON1").Select
Range("H2:I142").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ1").Select
Range("L2:M142").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON1").Select
Range("G2:G142").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ1").Select
Range("O2:O142").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'
' Tri suivant les points
With Sheets("CLASSJ1")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("M2:M142"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("L2:L142"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("I2:I142"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B2142")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
Sub ClassJ2()
'
' trier 2eme journée
' copie des donnees
Sheets("INSCRIPTION").Select
Range("A2:E142").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ2").Select
Range("B2:F142").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON2").Select
Range("B2:F171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ2").Select
Range("G2:K171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON2").Select
Range("H2:I171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ2").Select
Range("L2:M171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON2").Select
Range("G2:G171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ2").Select
Range("O2:O171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'
' Tri suivant les points
With Sheets("CLASSJ2")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("M2:M171"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("L2:L171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("I2:I171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B2:M171")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
Sub ClassJ3()
'
' trier 3eme journée
' copie des donnees
Sheets("INSCRIPTION").Select
Range("A2:E142").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ3").Select
Range("B2:F142").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON3").Select
Range("B2:F171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ3").Select
Range("G2:K171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON3").Select
Range("H2:I171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ3").Select
Range("L2:M171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON3").Select
Range("G2:G171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ3").Select
Range("O2:O171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'
' Tri suivant les points
With Sheets("CLASSJ3")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("M2:M171"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("L2:L171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("I2:I171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B2:M171")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
Sub ClassJ4()
'
' trier 4eme journée
' copie des donnees
Sheets("INSCRIPTION").Select
Range("A2:E142").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ4").Select
Range("B2:F142").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON4").Select
Range("B2:F171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ4").Select
Range("G2:K171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON4").Select
Range("H2:I171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ4").Select
Range("L2:M171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("POISSON4").Select
Range("G2:G171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSJ4").Select
Range("O2:O171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'
' Tri suivant les points
With Sheets("CLASSJ4")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("M2:M171"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("L2:L171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("I2:I171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B2:M171")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
Sub Classgene()
'
' Classement générale sur 4 journées
' copie des donnees
Sheets("INSCRI").Select
Range("A2171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("B2:E171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'
'copie des pts de la journée 1
Sheets("CLASSJ1").Select
Range("I2:I171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("J2:J171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("CLASSJ1").Select
Range("L2:L171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("K2:K171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("CLASSJ1").Select
Range("N2:N171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("L2:L171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'
'copie des pts de la journée 2
Sheets("CLASSJ2").Select
Range("I2:I171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("M2:M171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("CLASSJ2").Select
Range("L2:L171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("N2:N171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("CLASSJ2").Select
Range("N2:N171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("O2:O171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'
'copie des pts de la journée 3
Sheets("CLASSJ3").Select
Range("I2:I171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("P2171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("CLASSJ3").Select
Range("L2:L171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("Q2:Q171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("CLASSJ3").Select
Range("N2:N171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("R2:R171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'
'copie des pts de la journée 4
Sheets("CLASSJ4").Select
Range("I2:I171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("S2:S171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("CLASSJ4").Select
Range("L2:L171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("T2:T171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("CLASSJ4").Select
Range("N2:N171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCUL").Select
Range("U2:U171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False '
' Tri suivant les points places
With Sheets("CALCUL")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("I2:I171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("F2:F171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("H2:H171"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("G2:G171"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B2:U171")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
' copie des resultats
Sheets("CALCUL").Select
Range("B2:I171").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CLASSGENE").Select
Range("B2:I171").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub

 

[Paritec]

Re : Base de donnée excel avec VBA

Bonjour Melek le forum
J'espère que les responsables et modérateurs du site vont supprimer ton post et ta demande
Tu viens pour la première fois sur ce site et tu n'es même pas capable de dire bonjour????
Te présenter, tu n'es pas obligé, mais dire bonjour tout de même!!!!
Tu devrais lire la charte du forum
bonne journée
Papou

 

[Modeste geedee]

Re : Base de donnée excel avec VBA

Bonsour®

aucun répondeur ne va se lancer à reconstituer la structure d'un classeur à partir d'une expectoration de lignes de code...

la lecture de la charte , t'aurai proposé de joindre un classeur représentatif de la question...

 

[melek]

Re : Base de donnée excel avec VBA

Bonjour à tous;
excusez moi pour la question précédente. car j'ai plusieurs problèmes a résoudre dans m'a base; bref je présente mon problème majeur:
je dois filtrer et extraire des données suivant des critères; en faite je dois extraire les résultats des trois joueurs les mieux classer pour chaque club de la feuille "ClASSJ1" et l'enregistrer dans la feuille "CLASSCLUB" du même classeur.
vous trouverez en pièce jointe ma base

je vous remercie infiniment d'avoir la peine à lire .

 

[cathodique]

Re : Base de donnée excel avec VBA

Bonjour Melek,

Mes compétences en la matière ne me permettent pas de résoudre ton problème. Cependant, je peux te dire pourquoi on t'a invité à consulter la charte du forum. Tu aurais pu apprendre qu'il faut joindre un fichier.

Cordialement,

Cathodique

 

[Staple1600]

Re : Base de donnée excel avec VBA

Bonjour à tous

melec [Bienvenue sur le forum]

je vous remercie infiniment d'avoir la peine à lire .

Pour soulager la pénibilité de lecture de ton premier message (bravo , tu fais fort pour ton premier message )
Tu peux:
1) Modifier ton code comme ci-dessous en supprimant les Select et Activate
2) utiliser les balises idoines* pour formater le code VBA dans ton message

(* voir à ce sujet ma signature)​

Sub Classgene()
' Classement générale sur 4 journées
' copie des donnees
Sheets("INSCRI").Range("A2171").Copy
Sheets("CALCUL").Range("B2:E171").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'copie des pts de la journée 1
Sheets("CLASSJ1").Range("I2:I171").Copy
Sheets("CALCUL").Range("J2:J171").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("CLASSJ1").Range("L2:L171").Copy
Sheets("CALCUL").Range("K2:K171").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("CLASSJ1").Range("N2:N171").Copy
Sheets("CALCUL").Range("L2:L171").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'copie des pts de la journée 2
' à toi de continuer le "nettoyage" ;-)
'copie des pts de la journée 3
' à toi de continuer le "nettoyage" ;-)
'copie des pts de la journée 4
' à toi de continuer le "nettoyage" ;-)
' Tri suivant les points places
With Sheets("CALCUL")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("I2:I171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("F2:F171"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("H2:H171"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("G2:G171"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B2:U171")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
'copie des resultats
Sheets("CALCUL").Range("B2:I171").Copy
Sheets("CLASSGENE").Range("B2:I171").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub

Le moins chronophage, restant comme précédemment suggéré de joindre un fichier exemple.

 

[melek]

Re : Base de donnée excel avec VBA

bon jour a tous
la pièce jointe

 

[melek]

Re : Base de donnée excel avec VBA

bonjour;
merci staplet de tes conseils j'ai envoyé la pièce.

 

[melek]

Re : Base de donné e excel avec VBA

Bonjour Melek,

Mes compétences en la matière ne me permettent pas de résoudre ton problème. Cependant, je peux te dire pourquoi on t'a invité à consulter la charte du forum. Tu aurais pu apprendre qu'il faut joindre un fichier.

Cordialement,

Cathodique

Bonjour Cathodique[/QUOTE] ; Merci pour votre aide; j'ai envoyé un fichier jointe.

 

[cathodique]

Re : Base de donnée excel avec VBA

Bonjour Melek,

Comme je te l'avais dit dans mon précédent message. J'aurai bien aimé te venir en aide mais je ne maitrise pas assez le codage. j'apprends à mon rythme et quand je peux le vba. Je m'inspire beaucoup des exemples de Boisgontier ICI.

Tu as eu un code de stapple, l'as-tu adapté? de plus j'ai remarqué dans ton code une feuille "INSCRI" qui n'existe pas sur ton fichier.

Je te propose de faire une base de données sur une feuille (il ne doit pas y avoir de vide sur la 1ère ligne et la 1ère colonne). sur la 1ère colonne tu peux mettre les numéros de licence. tu renseignes cette feuille via un formulaire et ensuite par macro tu pourras extraire les données que tu souhaites à partir de cette bd.

essaie aussi d'être un peu plus clair sur le résultat escompté.

Cordialement,

Cathodique