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

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
 

pierrejean

XLDnaute Barbatruc
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:

gilbert_RGI

XLDnaute Barbatruc
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
 

Flop

XLDnaute Occasionnel
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.
 

Spitnolan08

XLDnaute Barbatruc
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:

Paritec

XLDnaute Barbatruc
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
 

Paritec

XLDnaute Barbatruc
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:

Flop

XLDnaute Occasionnel
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 !! :D
 

Flop

XLDnaute Occasionnel
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 !! :D


PS, c'est de ma faute l'erreur avec HIT ou HITS, dans mon énoncé j'ai marqué HIT et dans mon code HITS :)
 

Paritec

XLDnaute Barbatruc
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
 

gilbert_RGI

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

Discussions similaires

Statistiques des forums

Discussions
312 920
Messages
2 093 641
Membres
105 772
dernier inscrit
Momzo