Macro qui ne fonctionne pas
Bonjour à tous
Function FeuilleDerniereLigne(Feuille As Worksheet) As Long
FeuilleDerniereLigne = Feuille.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End Function
Sub copier_donnees_4()
Dim wb_actif As Workbook
Dim Feuille As Worksheet
Dim plage1 As Range
Dim plage2 As Range
Dim dernLig As Long
'Obtenir le classeur actif
Set wb_actif = ActiveWorkbook
'Créer la feuille "résultats" à la fin des feuilles "Course"
Set Feuille = wb_actif.Sheets.Add(after:=wb_actif.Sheets(wb_actif.Sheets.Count))
Feuille.Name = "résultats"
'Copier les résultats de chaque feuille "Course" dans la feuille "résultats"
For Each Feuille In wb_actif.Worksheets
If Feuille.Name Like "Course" Then
dernLig = FeuilleDerniereLigne(Feuille) + 1
If Feuille.Range("A3").Value = "" Then
Feuille.Range("A2").Copy Feuille.Range("A" & dernLig)
ElseIf Feuille.Range("A2").Value Like "Quinté" Then
Feuille.Range("A33:C33").Copy Feuille.Range("A" & dernLig)
ElseIf Feuille.Range("A4:A9").Find("", LookIn:=xlValues).Row >= 4 And Feuille.Range("A4:A9").Find("", LookIn:=xlValues).Row <= 9 Then
Set plage1 = Feuille.Range("A29:C29")
dernLig = Feuille.Range("A4:A9").Find("", LookIn:=xlValues).Row
plage1.Copy Feuille.Range("A" & dernLig)
ElseIf Feuille.Range("A10:A12").Find("", LookIn:=xlValues).Row >= 10 And Feuille.Range("A10:A12").Find("", LookIn:=xlValues).Row <= 12 Then
Set plage1 = Feuille.Range("A" & dernLig)
ElseIf Feuille.Range("A13:A27").Find("", LookIn:=xlValues).Row >= 13 And Feuille.Range("A13:A27").Find("", LookIn:=xlValues).Row <= 27 Then
Set plage1 = Feuille.Range("A31:C31")
dernLig = Feuille.Range("A10:A12").Find("", LookIn:=xlValues).Row
plage1.Copy Feuille.Range("A" & dernLig)
ElseIf Feuille.Range("A13:A27").Find("", LookIn:=xlValues).Row >= 13 And Feuille.Range("A13:A27").Find("", LookIn:=xlValues).Row <= 27 Then
Set plage1 = Feuille.Range("A35:C35")
dernLig = Feuille.Range("A13:A27").Find("", LookIn:=xlValues).Row
plage1.Copy Feuille.Range("A" & dernLig)
End If
End If
Next Feuille
End Sub
bonjour, j'ai une macro qui s'exécute mais qui ne me copie rien du tout dans le classeur actif la macro crée une feuille" résultats" il y a des feuilles "Course" incrémentées suivant les données injectées donc il peut y avoir 10 feuilles "Course" comme 300 feuilles "Course" incrémentée 1,2 ,3etc
"Course1" si la cellule "A2" contient le mot "Quinté" alors on copie la plage de cellules"A33aC33" vers la première ligne vide de la feuille créee: "résultats" ,cette condition prime sur les suivantes
Si la première cellule vide est "A3" alors on copie le cellule "A2" vers la première ligne vide de la feuille "résultats"
Si la première cellule vide se situe entre "A4etA9" alors on copie la plage de cellules "A29aC29" vers la première ligne vide de la feuille "résultats"
Si la première cellule vide se situe entre "A10etA12" alors on copie la plage de cellules "A31aC31" vers la première ligne vide de la feuille "résultats"
Si la première cellule vide se situe entre "A13etA27" alors on copie la plage de cellules "A35aC35" vers la première ligne vide de la feuille "résultats"
il n'y a qu'une condition possible pour chaque feuille "Course" et toutes ces conditions doivent être répétées pour chaque feuille "Course" incrémentée
Dans la macro que je vous met en pièce jointe , elle s'exécute jusqu'au bout mais ne me copie rien dans la feuille "résultats"
je vous joins la macro ainsi qu'un fichier pour que vous puissiez essayer
d'avance merçi
Bonjour Berjac,
Je ne suis pas rentré en détail dans le code mais au vu des copies jointes, il y a plusieurs points qui m'interpellent :
- Tu utilises le même objet "Feuille" pour pointer vers la feuille "Résultat" que tu crées et pour lire les feuilles "Course xx". Il te faut 2 objets WorkSheet distinct, l'un pour la feuille résultat, l'autre pour lire les feuilles "Course". Feuille.Range("A2").Copy Feuille.Range("A" & dernLig)
devrait être du genre être Feuille.Range("A2").Copy FeuilleResult.Range("A" & dernLig)
ou FeuilleResult serait la feuille ajoutée dans le classeur et dans laquelle tu rechercherais la dernière ligne.
- L'opérateur like a besoin des caractères génériques * ou ? sinon cela revient à utiliser l'opérateur =. Exemples, tu devrais avoir : Like "Course*", Like "*quinté*".
Je n'affirme pas que ces corrections résoudront tous les problèmes mais tu devrais déjà y voir plus clair.
Cdlt,
Cylfo
Bonsoir et merçi pour ton aide mais en modifiant la macro j'ai du faire une chose qui n'est pas clair surement dans les définitions
Function FeuilleDerniereLigne(Feuille As Worksheet) As Long
FeuilleDerniereLigne = Feuille.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End Function
Sub copier_donnees_3()
Dim wb_actif As Workbook
Dim Feuille As Worksheet
Dim plage1 As Range
Dim plage2 As Range
Dim dernLig As Long
'Obtenir le classeur actif
Set wb_actif = ActiveWorkbook
'Créer la feuille "résultats" à la fin des feuilles "Course"
Set Feuille = wb_actif.Sheets.Add(after:=wb_actif.Sheets(wb_actif.Sheets.Count))
Feuille.Name = "résultats"
'Copier les résultats de chaque feuille "Course" dans la feuille "résultats"
For Each Feuille In wb_actif.Worksheets
If Feuille.Name Like "Course*" Then
If Feuille.Range("A3").Value = "" Then
dernLig = FeuilleDerniereLigne(FeuilleResult) + 1
Feuille.Range("A1").CurrentRegion.Copy FeuilleResult.Range("A" & dernLig)
ElseIf Feuille.Range("A2").Value Like "*Quinté*" Then
dernLig = FeuilleDerniereLigne(Feuille) + 1
Feuille.Range("A33:C33").Copy FeuilleResult.Range("A" & dernLig)
ElseIf Feuille.Range("A4:A9").Find("", LookIn:=xlValues).Row >= 4 And Feuille.Range("A4:A9").Find("", LookIn:=xlValues).Row <= 9 Then
Set plage1 = FeuilleResult.Range("A29:C29")
Set plage2 = FeuilleResult.Range("A33:C33")
dernLig = FeuilleDerniereLigne(Feuille) + 1 'Correction de l'erreur de compilation ici
plage1.Copy FeuilleResult.Range("A" & dernLig)
End If
End If
Next Feuille
End Sub
Re,
Tu as oublié de modifier
Set Feuille = wb_actif.Sheets.Add(after:=wb_actif.Sheets(wb_actif.Sheets.Count))
Feuille.Name = "résultats"
En
Dim FeuilleResult as WorkSheet
Set FeuilleResult = wb_actif.Sheets.Add(after:=wb_actif.Sheets(wb_actif.Sheets.Count))
FeuilleResult.Name = "résultats"
bonjour Cylfo, Berjac,
comme ça ?
Sub copier_donnees_4()
Dim wb_actif As Workbook
Dim Feuille As Worksheet, sh As Worksheet
Dim dernLig As Long
Dim Ligne1 As Variant
'Obtenir le classeur actif
Set wb_actif = ActiveWorkbook
'Créer la feuille "résultats" à la fin des feuilles "Course"
Set Feuille = wb_actif.Sheets.Add(after:=wb_actif.Sheets(wb_actif.Sheets.Count))
Feuille.Name = "résultats"
'Copier les résultats de chaque feuille "Course" dans la feuille "résultats"
Application.EnableEvents = False
For Each sh In wb_actif.Worksheets
If UCase(sh.Name) Like UCase("Course #*") Then
sh.Range("A2:A27").Name = "Berjac"
Ligne1 = "": Ligne1 = Evaluate("Aggregate(15, 6, Row(berjac) / (berjac = """"), 1)")
If Not IsNumeric(Ligne1) Then Ligne1 = 0
dernLig = Feuille.Range("A" & Rows.Count).End(xlUp).Row + 1
Feuille.Range("E" & dernLig).Value = sh.Name
If UCase(sh.Range("A2").Value) Like UCase("Quinté*") Then
sh.Range("A33:C33").Copy Feuille.Range("A" & dernLig)
Else
Select Case Ligne1
Case 3: sh.Range("A2").Copy Feuille.Range("A" & dernLig)
Case 4 To 9: sh.Range("A29:C29").Copy
Feuille.Range("A" & dernLig).PasteSpecial xlAll
Feuille.Range("A" & dernLig).PasteSpecial xlValues
Case 10 To 12: sh.Range("A31:C31").Copy
Feuille.Range("A" & dernLig).PasteSpecial xlAll
Feuille.Range("A" & dernLig).PasteSpecial xlValues
Case 13 To 27: sh.Range("A35:C35").Copy
Feuille.Range("A" & dernLig).PasteSpecial xlAll
Feuille.Range("A" & dernLig).PasteSpecial xlValues
Case Else: MsgBox "autre choix" & Ligne1, vbExclamation, sh.Name
End Select
End If
End If
Next
Feuille.UsedRange.EntireColumn.AutoFit
End Sub
bonjour Bart et Cylfo
merçi à vous deux je ne sais pas si je pourrai essayer ce soir mais je vous donnerai des nouvelles quelles qu'elles soient
bonne soirée
Jacques
et Merçi
MAGNIFIQUE!!!!!
tout fonctionne super bien la seule chose c'est que pour la course"Quinté" il ne me copie pas la plage"A33aC33" il me copie la plage en rapport à la première cellule vide il aurait fallu que le condition :Si dans la cellule A2 il y a le mot "Quinté", alors on copie la plage de cellules"A33aC33" et passe devant les autres conditions mais bravo!!!!! sinon c'est exactement ce qu'il me fallait
MERCI MERCI MERCI
re,
alors la section pour "Quinté"
....
If UCase(sh.Range("A2").Value) Like UCase("Quinté*") Then
sh.Range("A33:C33").Copy
Feuille.Range("A" & dernLig).PasteSpecial xlAll
Feuille.Range("A" & dernLig).PasteSpecial xlValues
Else
....
voilà Bart,
je te renvoie le code il fonctionne bien sauf que pour la ligne ou il y a "Quinté" il me prend la condition si première cellule vide est donc dans ce cas c'est la plage "A35aC35" au lieu de la plage "A33aC33" mais si tu n'y arrives pas c'est pas grave je le ferai manuellement et je te remercie encore je te renvoie le code avec le changement pour etre sur que c'est pas moi qui ai fait une connerie
Sub copier_donnees_le_bon()
Dim wb_actif As Workbook
Dim Feuille As Worksheet, sh As Worksheet
Dim dernLig As Long
Dim Ligne1 As Variant
'Obtenir le classeur actif
Set wb_actif = ActiveWorkbook
'Créer la feuille "résultats" à la fin des feuilles "Course"
Set Feuille = wb_actif.Sheets.Add(after:=wb_actif.Sheets(wb_actif.Sheets.Count))
Feuille.Name = "résultats"
'Copier les résultats de chaque feuille "Course" dans la feuille "résultats"
Application.EnableEvents = False
For Each sh In wb_actif.Worksheets
If UCase(sh.Name) Like UCase("Course #*") Then
sh.Range("A2:A27").Name = "Berjac"
Ligne1 = "": Ligne1 = Evaluate("Aggregate(15, 6, Row(berjac) / (berjac = """"), 1)")
If Not IsNumeric(Ligne1) Then Ligne1 = 0
dernLig = Feuille.Range("A" & Rows.Count).End(xlUp).Row + 1
Feuille.Range("E" & dernLig).Value = sh.Name
If UCase(sh.Range("A2").Value) Like UCase("Quinté*") Then
sh.Range("A33:C33").Copy
Feuille.Range("A" & dernLig).PasteSpecial xlAll
Feuille.Range("A" & dernLig).PasteSpecial xlValues
Else
Select Case Ligne1
Case 3: sh.Range("A2").Copy Feuille.Range("A" & dernLig)
Case 4 To 9: sh.Range("A29:C29").Copy
Feuille.Range("A" & dernLig).PasteSpecial xlAll
Feuille.Range("A" & dernLig).PasteSpecial xlValues
Case 10 To 12: sh.Range("A31:C31").Copy
Feuille.Range("A" & dernLig).PasteSpecial xlAll
Feuille.Range("A" & dernLig).PasteSpecial xlValues
Case 13 To 27: sh.Range("A35:C35").Copy
Feuille.Range("A" & dernLig).PasteSpecial xlAll
Feuille.Range("A" & dernLig).PasteSpecial xlValues
Case Else: MsgBox "autre choix" & Ligne1, vbExclamation, sh.Name
End Select
End If
End If
Next
Feuille.UsedRange.EntireColumn.AutoFit
End Sub
re, ma faute, il faut changer ces 33 en 35 !!!
If UCase(sh.Range("A2").Value) Like UCase("Quinté*") Then
sh.Range("A33:C33").Copy
sh.Range("A35:C35").Copy
...
lol j'avais meme pas vu c'est de ma faute
bonne soirée Bart
Jacques
en fait c'est bien la plage "A33aC33" qui doit être copiée quand il y a le mot "Quinté" dans la cellule A2 mais visiblement il prend en compte une condition dans le select case car il ne me copie pas la plage A33aC33 mais bien la plage A35aC35 ou alors il ne prend pas en compte le mot "Quinté" car le mot "Quinté" est toujours
entouré de -- c'est à dire comme ça -Quinté-
sinon je ne vois pas
Jacques
j'ai même essayé en mettant dans le code -Quinté- de cette façon mais ça ne change rien
Bonne soirée
Jacques
aha, ce sera le choix entre ...
If UCase(sh.Range("A2").Value) Like UCase("*-Quinté-*") Then ' =>>> contient "-Quinté-", par exemple "xyz-Quinté-abc"
If StrComp(sh.Range("A2").Value,"-Quinté-",1)=0 Then '=>>> exactement "-Quinté-"
Bonjour Bart,
alors pour le problème Quinté j'ai tout essayé
dans aucun cas il ne me copie les plages "A33aC33" j'ai même essayé de remplir les cellules de la colonne A jusqu'à A27 et là il me dit autre choix, en fait je pense qu'il exécute bien le premier if mais que ensuite même si la première condition est remplie, il continue les instructions et comme il y a toujours une instruction "vraie", il prend en compte cette dernière, donc je pense que après la conditions Si "Quinté" est exact il faudrait directement sortir de la boucle sans passer par le select case
voilà si tu peux y jeter un oeuil voilà je te souhaite une excellente journée avec ce beau temps
Jacques
re,
Avez-vous un fichier avec un "Quinté" comme ça ?
oui je vous envoie ça
le mot quinté est dans l'avant dernière feuille il me semble le mot -Quinté- est toujours écrit de la même manière
Merçi Bart et bonne journée
Jacques
re, votre fichier de retour
Bravo!!!!!
Un Grand Merçi Bart Tout Est Super
Je ferme le sujet et encore Bravo
Jacques