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

  • 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 !

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
 
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:
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
 
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.
 
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:
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
 
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:
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 !! 😀
 
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 !! 😀


PS, c'est de ma faute l'erreur avec HIT ou HITS, dans mon énoncé j'ai marqué HIT et dans mon code HITS 🙂
 
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
 
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

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 !!!!
 
- 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

Réponses
5
Affichages
567
Réponses
1
Affichages
406
Réponses
2
Affichages
737
Réponses
22
Affichages
3 K
Retour