Procédure appelant les macros "Recherche", "Répéter" et "copier/coller"
Bonsoir le forum,
Je progresse en Vba, mais pour ce qui est de la logique dans les boucles pour rechercher des feuilles bien précise, je suis perdu.
J’ai réussi à faire en sorte que ma macro copie les valeurs de chaque feuilles « Poule 3j (2), Poule 4j (2), etc…, dans ma feuille « CTF » ligne après ligne. Où je coince, c’est de créer le code pour la recherche des feuilles « Poule 3j (2), Poule 4j (2), etc…, car je n’aurai pas forcément une poule de chaque, mais peut-être 2 feuilles de « Poule 3j (2) » ou 5 feuilles de « Poule 4j (2) » etc., voir mon début de code sur la feuille « CTF ».
Voici les problèmes à résoudre :
- Faire une recherche des feuilles qui commencent par « Poule » ou « Groupe » ou « Gr », et que la valeur (2) change aussi...explication; Poule 3j (2), Poule 3j (3), etc., la valeur entre parenthèse est le nombre de feuille identique.
- Adapter le code en fonction des noms des feuilles qu’on renommera soit « Poule », « Groupe » ou « Gr ».
J’ai déjà écrit le code pour copier/coller de toutes les Poules (de 3j à 10j), merci à celui qui voudra passer un peu de son temps pour m’aider, à adapter ma macro. Pour créer une autre poule, aller sur la feuille « Infos générales ».
Bonjour
Faire une recherche des feuilles qui commencent par « Poule » ou « Groupe » ou « Gr », et que la valeur (2) change aussi...explication; Poule 3j (2), Poule 3j (3), etc., la valeur entre parenthèse est le nombre de feuille identique.
Pourquoi appliquer plusieurs noms pour ce que tu veux faire dans le sport on dit Poule
et pourquoi poule 3j que veut dire le j?
Le code pourra être adapté que si toutes tes feuilles commence par le même nom exemple poule 1, poule 2 ...
Quand on fait le tour des codes que tu as mis ,on se trouve à l'intérieur d'une véritable usine à gaz
Bonjour le forum et Joco7915,
Merci pour ton commentaire et j’ai rectifié la nomination de mes feuilles selon ton commentaire.
La feuille Poule 3, est la feuille d’origine que je ne peux pas supprimer, car mon code copie cette feuille et comme vous le savez tous, on ne peut pas avoir deux fois la même feuille avec le même nom, donc j’aurai « Poule 3 (2) ».
Poule de 4 joueurs à Poule 4 (2)
Poule de 5 joueurs à Poule 5 (2)
Ect..
« Pourquoi appliquer plusieurs noms pour ce que tu veux faire dans le sport on dit Poule »
Pour la réponse… une autre personne préfèrera nommer ces feuilles par Groupe 1, 2, 3, etc.
Infos sur les Poules et la sélection des données :
Poule 3 (2) : Sélections des numéros des joueurs BC32:BC59 (identique pour toutes les poules)
Sélections des scores L15;T17
Poule 4 (2) : Sélections des scores O15;W18
Poule 5 (2) : Sélections des scores R15;Z19
Poule 6 (2) : Sélections des scores U15;AC20
Poule 7 (2) : Sélections des scores X15;AF21
Poule 8 (2) : Sélections des scores AA15;AI22
Poule 9 (2) : Sélections des scores AD15;AL23
Poule 10 (2) : Sélections des scores AG15;AO24
Dans le fichier joint, un exemple avec 29 joueurs, réparties sur 5 poules (de 5 joueurs) et une poule (de 4 joueurs). Mon code actuel fonctionne uniquement si j’ai des feuilles de « Poules de 3 (2) à 10 (2) » dans l’ordre. Mais si j’ai une autre combinaison de feuilles « Poule 5 (2), Poule 5 (3), Poule 5 (4), Poule 4 (2) », mon code ne fonctionne pas !
D’où ma demande, et c’est là que moi je coince, le code doit rechercher les feuilles, si elles existent, d’exécuter le code de copier/coller vers la feuille « CTF » à la suite, en A11 (numéros des joueurs) et en E11;M11 (les scores).
Merci d’avance pour votre temps.
J’ai oublié de préciser, que les feuilles seront renommées comme suite :
Poule 5 (2) à Poule 1
Poule 5 (3) à Poule 2
Poule 5 (4) à Poule 3
Poule 5 (5) à Poule 4
Poule 4 (2) à Poule 5
Etc..
Bonjour le forum,
Après plusieurs recherche sur le net et en bricolant, j'ai réussit à résoudre mon problème de ma macro "Rechercher, Répéter et copier/coller" de mon programme tournoi de tennis de table. Pour ceux que ça intéresse, voir code si dessous :
Sub Inserer_click()
Application.ScreenUpdating = False
Sheets("CTF").Visible = True
Dim wsSource As Worksheet, wsDest As Worksheet, ws As Worksheet
Dim rngSource As Range, rngDest As Range
Dim LastRow As Long
Dim wb As Workbook
Set wb = ThisWorkbook
Set wsDest = ThisWorkbook.Sheets("CTF")
'Effacer les données de la feuille CTF
wsDest.Range("A3:A258,E3:E258,G3:H258,J3:K258,M3:M258").ClearContents
LastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row + 2 ' copiera les données à la 3èmes lignes
For Each ws In wb.Sheets
If Left(ws.Name, 2) = "Gr" Then 'le 2, correspond aux nombres de caratères du nom de la feuille (poule = 5)
' Copy values from column Groupe
Set wsSource = ws
Set rngSource = wsSource.Range("BC32:BC59")
For i = 1 To rngSource.Rows.Count
If Not IsEmpty(rngSource.Cells(i, 1)) Then
wsDest.Range("A" & LastRow).Value = rngSource.Cells(i, 1).Value
LastRow = LastRow + 1
End If
Next i
End If
Next ws
'CopyDataFromGrSheets_Click()
Dim lstRow As Long
Dim grSheet As String
' Feuille de destination
For i = 1 To 6
grSheet = "Gr" & i & "-3"
' Vérifier si la feuille existe
If Not SheetExists(grSheet) Then
grSheet = "Gr" & i & "-4"
If Not SheetExists(grSheet) Then
grSheet = "Gr" & i & "-5"
If Not SheetExists(grSheet) Then
grSheet = "Gr" & i & "-6"
If Not SheetExists(grSheet) Then
grSheet = "Gr" & i & "-7"
If Not SheetExists(grSheet) Then
grSheet = "Gr" & i & "-8"
If Not SheetExists(grSheet) Then
grSheet = "Gr" & i & "-9"
If Not SheetExists(grSheet) Then
grSheet = "Gr" & i & "-10"
If Not SheetExists(grSheet) Then
Exit For
End If
End If
End If
End If
End If
End If
End If
End If
' Trouver la dernière ligne utilisée dans la feuille de destination
lstRow = wsDest.Range("E" & wsDest.Rows.Count).End(xlUp).Row
' Copier les données de la feuille Gr-3, Gr-4, Gr-5, Gr-6, Gr-7, Gr-8, Gr-9 ou Gr-10 en fonction de la feuille qui existe
If grSheet = "Gr" & i & "-3" Then
ThisWorkbook.Sheets(grSheet).Range("L15: T17").Copy
ElseIf grSheet = "Gr" & i & "-4" Then
ThisWorkbook.Sheets(grSheet).Range("O15:W18").Copy
ElseIf grSheet = "Gr" & i & "-5" Then
ThisWorkbook.Sheets(grSheet).Range("R15:Z19").Copy
ElseIf grSheet = "Gr" & i & "-6" Then
ThisWorkbook.Sheets(grSheet).Range("U15:AC20").Copy
ElseIf grSheet = "Gr" & i & "-7" Then
ThisWorkbook.Sheets(grSheet).Range("X15:AF21").Copy
ElseIf grSheet = "Gr" & i & "-8" Then
ThisWorkbook.Sheets(grSheet).Range("AA15:AI22").Copy
ElseIf grSheet = "Gr" & i & "-9" Then
ThisWorkbook.Sheets(grSheet).Range("AD15:AL23").Copy
ElseIf grSheet = "Gr" & i & "-10" Then
ThisWorkbook.Sheets(grSheet).Range("AG15:AO24").Copy
End If
wsDest.Range("E" & lstRow + 1).PasteSpecial xlPasteValues
' Ajout des valeurs 999
For j = 3 To 258
If IsEmpty(ThisWorkbook.Sheets("CTF").Range("G" & j).Value) Then
ThisWorkbook.Sheets("CTF").Range("G" & j).Value = 999
End If
Next j
Next i
Sheets("CTF").Activate
Range("A11").Activate
Sheets("CTF").Visible = False
Sheets("Infos générales").Select
Application.ScreenUpdating = True
End Sub
' Fonction pour vérifier si une feuille existe
Function SheetExists(sheetName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0
If Not ws Is Nothing Then
SheetExists = True
Else
SheetExists = False
End If
End FunctionC'est un peu long, mais je n'ai pas trouvé plus cours