Macro qui ne fonctionne pas

Le 26/06/2023 à 16:08
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

7pronos-2023-6-26-13-20.xlsm (267.27 Ko)
4pronos-2023-6-26-13-44.zip (610.35 Ko)

"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

Le 26/06/2023 à 17:14

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

Le 26/06/2023 à 18:08

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
Le 26/06/2023 à 18:40

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"
Le 26/06/2023 à 18:44

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
Le 26/06/2023 à 19:08

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

Le 26/06/2023 à 19:24

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

Le 26/06/2023 à 20:18

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
 ....
Le 26/06/2023 à 20:54

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
Le 26/06/2023 à 21:24

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

...

Le 26/06/2023 à 21:40

lol j'avais meme pas vu c'est de ma faute

bonne soirée Bart

Jacques

Le 26/06/2023 à 21:54

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

Le 26/06/2023 à 21:56

j'ai même essayé en mettant dans le code -Quinté- de cette façon mais ça ne change rien

Bonne soirée

Jacques

Le 26/06/2023 à 22:25

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

Le 27/06/2023 à 07:58

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

Le 27/06/2023 à 08:34

re,

Avez-vous un fichier avec un "Quinté" comme ça ?

Le 27/06/2023 à 10:21

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

3pronos-2023-6-27-10-19.zip (525.47 Ko)
Le 27/06/2023 à 10:36

re, votre fichier de retour

5pronos-2023-6-27-10-19.zip (528.15 Ko)
Le 27/06/2023 à 11:20

Bravo!!!!!

Un Grand Merçi Bart Tout Est Super

Je ferme le sujet et encore Bravo

Jacques

Rechercher des sujets similaires à "macro qui fonctionne pas"