construction d'une boucle avec petite incrémentation.. (bis)

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Flop
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Flop

Flop

XLDnaute Occasionnel
Salut à tous, je ne sais pas faire les boucles et j'ai besoin d'aide, voici mon code et la variable à incrémenter (HIT)


J'ai trois feuilles HIT;

HIT 1
HIT 2
HIT 3

je voudrais que cette macro s'excute pour les feuilles, hit 1, hit 2, hit 3


'---------------------------------------
Code: 
Sub test_boucle()


' on cache les étapes de mise en forme
Application.ScreenUpdating = False
Application.DisplayAlerts = False

' Définition des variables
Dim strDate As String
Dim datNow As Date
datNow = Now
region = Sheets("Config").Range("E9")

' copie de la page de données
Sheets("HITS").Visible = True
ThisWorkbook.Sheets("HITS").Copy

' supprime  les liaisons/formules
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Cells(1, 1).Select

' Répertoire de lecture
rep = "C:\MES DOCUMENTS\"

' définition des variables
strDate = UCase("(Sem " & Format(Format(datNow, "ww", vbMonday, vbFirstFourDays), "00") & ")")

'on efface l'objet
ActiveSheet.Shapes("accueil").Select
Selection.Delete

'effectue la conversion pour rendres les lignes vides et pouvoir les supprimer
    Range("D27").Select
    ActiveWindow.SmallScroll Down:=90
    Range("D27:D116").Select
    Selection.TextToColumns Destination:=Range("D27"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True

'supprime maintenant les lignes vides
On Error Resume Next
Range("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'on efface la cellule A1
Range("A1").ClearContents

'remonte en haut des lignes
Selection.AutoFill Destination:=Range("A49:A167"), Type:=xlFillDefault
ActiveWindow.SmallScroll Down:=-147
Range("A1").Select

' sauvegarde du fichier
ActiveWorkbook.SaveAs Filename:=rep & "TEST".xls"

ActiveWorkbook.Close
' message de bravo :-)
MsgBox "Export Réussi"
'on recache la feuille
Sheets("HITS").Visible = False

Call Protect_Protéger

End Sub
 
Trier par date Trier par votes
Re : construction d'une boucle avec petite incrémentation.. (bis)

bonjour Flop

Dans ce cas une solution est de mettre le nom de la feuille en parametre

la sub boucle devient par remplacement de "HITS" par feuille:

Code: 
Sub test_boucle(feuille as String)' on cache les étapes de mise en formeApplication.ScreenUpdating = False
Application.DisplayAlerts = False' Définition des variables
Dim strDate As StringDim datNow As DatedatNow = Nowregion = Sheets("Config").Range("E9")' copie de la page de donnéesSheets(feuille).Visible = TrueThisWorkbook.Sheets(feuille).Copy' supprime  les liaisons/formulesCells.SelectSelection.CopySelection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _False, Transpose:=FalseApplication.CutCopyMode = FalseCells(1, 1).Select' Répertoire de lecturerep = "C:\MES DOCUMENTS\"' définition des variablesstrDate = UCase("(Sem " & Format(Format(datNow, "ww", vbMonday, vbFirstFourDays), "00") & ")")'on efface l'objetActiveSheet.Shapes("accueil").SelectSelection.Delete'effectue la conversion pour rendres les lignes vides et pouvoir les supprimer    Range("D27").Select    ActiveWindow.SmallScroll Down:=90    Range("D27:D116").Select    Selection.TextToColumns Destination:=Range("D27"), DataType:=xlDelimited, _        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _        TrailingMinusNumbers:=True'supprime maintenant les lignes videsOn Error Resume NextRange("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete'on efface la cellule A1Range("A1").ClearContents'remonte en haut des lignesSelection.AutoFill Destination:=Range("A49:A167"), Type:=xlFillDefaultActiveWindow.SmallScroll Down:=-147Range("A1").Select' sauvegarde du fichierActiveWorkbook.SaveAs Filename:=rep & "TEST".xls"ActiveWorkbook.Close' message de bravo :-)MsgBox "Export Réussi"'on recache la feuilleSheets(feuille).Visible = FalseCall Protect_Protéger
End Sub

ensuite

Code: 
newsub()
for n= 1 to 3
 call Sub test_boucle("HIT" & n)
next n
End sub

Edit :désolé ,la recopie a supprimé toutes les fins de ligne !
 
Dernière édition:
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

Bonjour

ou de rectifier le code ainsi

Code: 
Sub test_boucle()


' on cache les étapes de mise en forme
Application.ScreenUpdating = False
Application.DisplayAlerts = False

' Définition des variables
Dim strDate As String
Dim datNow As Date
datNow = Now
region = Sheets("Config").Range("E9")

' copie de la page de données
For sh = 1 To 3
Sheets("HITS" & sh).Visible = True
ThisWorkbook.Sheets("HITS" & sh).Copy

' supprime  les liaisons/formules
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Cells(1, 1).Select

' Répertoire de lecture
rep = "C:\Mes Documents\"

' définition des variables
strDate = UCase("(Sem " & Format(Format(datNow, "ww", vbMonday, vbFirstFourDays), "00") & ")")

'on efface l'objet
ActiveSheet.Shapes("accueil").Select
Selection.Delete

'effectue la conversion pour rendres les lignes vides et pouvoir les supprimer
    Range("D27").Select
    ActiveWindow.SmallScroll Down:=90
    Range("D27:D116").Select
    Selection.TextToColumns Destination:=Range("D27"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True

'supprime maintenant les lignes vides
On Error Resume Next
Range("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'on efface la cellule A1
Range("A1").ClearContents

'remonte en haut des lignes
Selection.AutoFill Destination:=Range("A49:A167"), Type:=xlFillDefault
ActiveWindow.SmallScroll Down:=-147
Range("A1").Select

' sauvegarde du fichier
ActiveWorkbook.SaveAs Filename:=rep & "TEST" & sh & ".xls"

ActiveWorkbook.Close
' message de bravo :-)
MsgBox "Export Réussi"
'on recache la feuille
Sheets("HITS" & sh).Visible = False
Next

 Call Protect_Protéger

End Sub

Cdlt

RGI

edit : Salut pierrejean
 
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

@gilbert_RGI

j'arrive pas à faire marcher le code modifié, il m'indique :

Erreur d'exécution 9
l'indice n'appartient pas à la sélection

ca bloque sur :

("HITS" & sh)

@Pierre Jean, je vais tester ta soluce.
 
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

Bonjour le fil,

Juste de passage, une remarque :

Avec la macro de pierrejean🙂, si tes feuilles s'appellent HITS1, HITS2 et HITS3 il faut remplacer :
Code: 
call Sub test_boucle("HIT" & n)
par
Code: 
call Sub test_boucle("HITS" & n)
Dans tous les cas, il faut que tu aies 3 feuilles avec ces noms...

Cordialement

Edit : Et bien, visiblement (en suivant paritec) ce n'est pas Pierrejean qui s'est trompé dans l'appelation des feuilles mais GilbertRGI...
Mais visiblement ce n'est pas bon non plus : c'est :
Code: 
call Sub test_boucle("HIT " & n)
qu'il faut indiquer
ou
Code: 
Sheets("HIT " & sh).Visible = True
 
Dernière édition:
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

Bonjour Gilbert Pierrejean, Flop le forum
c'est normal que ça marche pas si tes feuilles s'appellent Hit, Gilbert a fait une faute il a écrit Hits, tu retires les S et c'est bon
a+
Papou
 
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

Bonjour à Tous,
alors moi je comprend plus, excuses Spinolan j'avais pas vu ta réponse, mais si on prend le premier post de Flop, c'est Hit 1 etc.
Bref à éclaircir
bonne soirée à tous
Papou
 
Dernière édition:
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

bon ca marche, je comprenais le message d'erreur, mes feuilles existe bien mais sous cette forme :

HITS 1, HITS 2, HITS 3

j'ai donc remplacer par

ThisWorkbook.Sheets("HIT" & " " & sh).Copy

et ca marche merci beaucoup à tous !! 😀
 
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

Flop à dit:
bon ca marche, je comprenais le message d'erreur, mes feuilles existe bien mais sous cette forme :

HITS 1, HITS 2, HITS 3

j'ai donc remplacer par

ThisWorkbook.Sheets("HIT" & " " & sh).Copy

et ca marche merci beaucoup à tous !! 😀
Cliquez pour agrandir...


PS, c'est de ma faute l'erreur avec HIT ou HITS, dans mon énoncé j'ai marqué HIT et dans mon code HITS 🙂
 
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

Bonsoir Gilbert Spinolan Flop et tous,
Oui j'avais pas vu dans le code il y avait bien HITS et dans l'énoncé Hit bref c'était pas une accusation simplement un moyen d'avancer.
amicalement à tous et bonne soirée
Papou
 
Vote positif 0 Vote négatif
Re : construction d'une boucle avec petite incrémentation.. (bis)

Paritec à dit:
Bonsoir Gilbert Spinolan Flop et tous,
Oui j'avais pas vu dans le code il y avait bien HITS et dans l'énoncé Hit bref c'était pas une accusation simplement un moyen d'avancer.
amicalement à tous et bonne soirée
Papou
Cliquez pour agrandir...

ce n'est pas Pierrejean qui s'est trompé dans l'appelation des feuilles mais GilbertRGI...

je sais ce n'est pas de Papou

c'est quoi ça alors !!!!
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
128
vazvaz
V
K
  • Question Question
Microsoft 365 vba :Vlookup + incrémentation d'une plage de donnée
Réponses
1
Affichages
352
vgendron
vgendron
L
  • Question Question
XL 2016 Actualisation d'une query via VBA
Réponses
5
Affichages
577
job75
job75
cocro
  • Question Question
Microsoft 365 Créer autant d'onglet que de commune dans ma base principale
Réponses
14
Affichages
736
job75
job75
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
Usine à gaz
  • Résolu(e)
XL 2021 recherche supprimer les espaces '"si valeur cherchée est numérique" sinon NON
Réponses
7
Affichages
768
Usine à gaz
Usine à gaz
chilo27
  • Question Question
Autres Simplifier une macro
Réponses
1
Affichages
414
fanch55
fanch55
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
U
  • Question Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
656
un internaute
U
Usine à gaz
  • Résolu(e)
XL 2021 Filtrage que je ne parviens pas à faire
Réponses
6
Affichages
679
Usine à gaz
Usine à gaz
U
  • Question Question
Autres [RÉSOLU] Faire afficher ligne sur tout le classeur par double clic et la faire maquer à l’enregistrement
Réponses
11
Affichages
864
un internaute
U
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
929
MickaeL_D
M
A
  • Résolu(e)
XL 2019 Passage de 2013 pro à 2019 pro, Pb avec formule VBA, liens hypertexte
2 3 4
Réponses
54
Affichages
3 K
sylvanu
sylvanu
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
4 K
fanou06
F
M
  • Question Question
Microsoft 365 Joindre une copie de 2 feuilles Excel dans outlook
Réponses
0
Affichages
597
Mika07
M
Q
  • Résolu(e)
Microsoft 365 Exécutions directes différentes vs "pas à pas"
Réponses
2
Affichages
580
Quentin2106
Q
D
  • Question Question
Microsoft 365 Optimisation boucle
Réponses
2
Affichages
750
Wayki
Wayki
J
  • Question Question
XL 2010 Difficulté avec Query
Réponses
5
Affichages
976
jm.andryszak
J
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
2 K
ERIC S
ERIC S
J
  • Question Question
XL 2019 Borné une extraction par date
2
Réponses
22
Affichages
3 K
jui42
J
Retour