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

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
pierrejean

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:
Vote positif 0 Vote négatif
gilbert_RGI

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
 
Vote positif 0 Vote négatif
Flop

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.
 
Vote positif 0 Vote négatif
Spitnolan08

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:
Vote positif 0 Vote négatif
Paritec

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
 
Vote positif 0 Vote négatif
Paritec

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:
Vote positif 0 Vote négatif
Flop

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
 
Vote positif 0 Vote négatif
Flop

Flop

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

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
 
Vote positif 0 Vote négatif
gilbert_RGI

gilbert_RGI

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

Discussions similaires

M
  • Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
16
Affichages
392
Phil69970
Phil69970
L
  • Question
XL 2016 Actualisation d'une query via VBA
Réponses
5
Affichages
299
job75
job75
A
  • Résolu(e)
XL 2016 Regroupement dates sur TCD
Réponses
3
Affichages
378
Aldonanou
A
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
228
marie3107
M
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
278
marie3107
M
E
  • Résolu(e)
Microsoft 365 Convertir en -tete tableau en date
Réponses
14
Affichages
459
eric72
E
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
576
Nicolas JACQUIN
Nicolas JACQUIN
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
Usine à gaz
  • Résolu(e)
XL 2021 recherche supprimer les espaces '"si valeur cherchée est numérique" sinon NON
Réponses
7
Affichages
414
Usine à gaz
Usine à gaz
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
666
mouchtre
mouchtre

Membres actuellement en ligne

7 membres et 56 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
313 344
Messages
2 097 335
Membres
106 916
dernier inscrit
Soltani mohamed