Boucle for/next avec valeur variable inconnue
Bonjour,
J'en suis à ma deuxième macro à ce jour, mais je reste encore novice.
j'ai collé la macro de ma boite de dialogue ci-dessous. elle fonctionne bien dans son ensemble.
mais j'aimerais perfectionner un critère et c'est là que j'ai besoin de l'aide d'un connaisseur.
Vous constaterez que je dois informer la comboBox1 d'une valeur variant de 1 à 7 ( 1 à 7 onglet possible )
afin que par la suite, elle aille chercher dans " i " onglet, les cellules correspondantes pour les copier/coller dans " i " onglet de mon dossier_en_cours".
Le nombre d'onglet est très variable selon les classeurs " reference.xls ". le variable reference est simplement 9 chiffres à la suite. il en existe 1000, mais ce n'est qu'un détail.
Est-il possible de ne pas être obligé d'informer ma boite de dialogue du nombre d'onglet présent dans chaque classeur "reference.xls" que je cherche ?
Existe-il un objet ou une fonction qui détermine automatiquement le nombre d'onglet présent dans un classeur au hasard?
Cela m'éviterai d'ouvrir le classeur "reference.xls" et de compter le nombre de onglet présent et d'en informer ma comboBox1 et d'envoyer la moulinette.
Merci d'avance pour votre aide
Private Sub ma_boite_de_dialogue()
Userform1.Show
' ---------Déclaration la variable pour la recherche du fichier excel puis du copier/coller
' ---------fichier excel du type, "reference.xls"
Dim reference As String, dossier_en_cours As String, nbonglet As integer.
'---------dossier_en_cours est le classeur Excel actif au moment de l'activation de la macro
dossier_en_cours = ActiveWorkbook.Name
'---------reference prend toute les valeurs existante de A1 à A1000 (RowSource reference!A1:A1000)
'---------nbonglet prend toute les valeurs existante de B1 à B7 (RawSource nbonglet!B1:B7)
nbonglet = Worksheets.Count
reference = ComboBox2.Value
'---------Ouverture de fichier selon le choix de de la liste déroulante "comboBox2" de la boite de dialogue, puis j'appui sur un bouton "suivant.
'---------grâce à la comboBox1 je choisie le nombre d'onglet à copier
Workbooks.Open Filename:="C:\" & reference.xls"
'---------Séquence de copier/coller entre la base de données C:\reference.xls jusqu'à le "dossier_en_cours"
'---------Mise en place d'une Boucle For avec nbonglet qui détermine le nombre d'onglet présent
Sheets(Dim Client).Range("H16:H23").Copy
Workbooks(dossier_en_cours).Activate
Sheets(Dim Client).Select
Range("H16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(reference).Activate
For i = 1 To nbonglet
Sheets("onglet_" & i).Range("H16:H23").Copy
Workbooks(dossier_en_cours).Activate
Sheets("onglet_" & i).Select
Range("H16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(reference).Activate
Next
'---------Fermeture du dossier de la Base de données
ActiveWindow.Close
Unload Me
End SubBonsoir ,
essaie ceci
nbonglet=worksheets.countOn se rapproche de la vérité mais ça ne fonctionnement pas "complètement"
il faut savoir que dans le classeur "dossier en cours.xls", il y a toujours 7 onglets nommer onglet_1 à onglet_7
que dans le classeur reference.xls, il peut exister entre 1 à 7 onglets.
j'ai un exemple :
le classeur dont la référence est 130053003.xls, contient seulement 2 onglets, onglet_1 et onglet_2
le classeur dossier en cours.xls, contient toujours 7 onglets, onglet_1 à onglet_7. J'admet que les onglets onglet_3 à onglet_7 ne sont pas utiles, mais ils doivent exister au cas ou si une des 1000 références contient 3, 4 onglets... et il est là le petit problème
grâce à
nbonglet=worksheets.countil m'a copier/coller les onglets onglet_1 et onglet_2, mais il a tenté de continuer avec le 3 qui n'existe pas dans 130053003.xls.
du coup : erreur d'exécution "9" : l'indice n'appartient pas à la sélection.
J'espère avoir bien expliqué le problème.
Merci
Bonsoir,
il faut mettre l'instruction après avoir ouvert le document dont on cherche le nombre d'onglets.
Private Sub ma_boite_de_dialogue()
Userform1.Show
' ---------Déclaration la variable pour la recherche du fichier excel puis du copier/coller
' ---------fichier excel du type, "reference.xls"
Dim reference As String, dossier_en_cours As String, nbonglet As integer.
'---------dossier_en_cours est le classeur Excel actif au moment de l'activation de la macro
dossier_en_cours = ActiveWorkbook.Name
'---------reference prend toute les valeurs existante de A1 à A1000 (RowSource reference!A1:A1000)
'---------nbonglet prend toute les valeurs existante de B1 à B7 (RawSource nbonglet!B1:B7)
reference = ComboBox2.Value
'---------Ouverture de fichier selon le choix de de la liste déroulante "comboBox2" de la boite de dialogue, puis j'appui sur un bouton "suivant.
'---------grâce à la comboBox1 je choisie le nombre d'onglet à copier
Workbooks.Open Filename:="C:\" & reference.xls"
nbonglet = Worksheets.Count
'---------Séquence de copier/coller entre la base de données C:\reference.xls jusqu'à le "dossier_en_cours"
'---------Mise en place d'une Boucle For avec nbonglet qui détermine le nombre d'onglet présent
Sheets(Dim Client).Range("H16:H23").Copy
Workbooks(dossier_en_cours).Activate
Sheets(Dim Client).Select
Range("H16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(reference).Activate
For i = 1 To nbonglet
Sheets("onglet_" & i).Range("H16:H23").Copy
Workbooks(dossier_en_cours).Activate
Sheets("onglet_" & i).Select
Range("H16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(reference).Activate
Next
'---------Fermeture du dossier de la Base de données
ActiveWindow.Close
Unload Me
End SubBonjour, cela ne fonctionne toujours pas. Après avoir copier les onglets existant, il tente encore de continuer à copier un onglet qui n'existe pas (enfin il me semble que c'est ce qu'il tente de faire). il fait bien le copier/coller des premiers onglets.
il surligne la ligne, et m'affiche le message d'erreur ( en PJ de ce message )
For i = 1 To nbonglet
Sheets("onglet_" & i).Range("H16:H23").Copy
Workbooks(dossier_en_cours).Activate
Sheets("onglet_" & i).Select
Range("H16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(reference).Activate
Next
Bonjour,
es-tu sûr de n'avoir que des onglets nommés onglet_x ? quid de l'onglet dim client ?
En PJ, la capture d'écran de mon fichier excel de la base de donnée, "reference.xls"
Bonjour à tous,
à la place d'une boucle "for i= to" j'utiliserai plutôt une boucle "for each".
Le principe:
je boucle sur chaque feuille du classeur, si le nom de la feuille est égale à "onglet_" & i alors je copie.je remplacerais :
For i = 1 To nbonglet
Sheets("onglet_" & i).Range("H16:H23").Copy
Workbooks(dossier_en_cours).Activate
Sheets("onglet_" & i).Select
Range("H16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(reference).Activate
Nextpar :
i = 1
For Each sh In Worksheets
If sh.Name = "onglet_" & i Then
sh.Range("H16:H23").Copy Workbooks(dossier_en_cours).Sheets("onglet_" & i).Range("H16")
i = i + 1
End If
Next shnote qu'a la place de tous les "select" et "activate" ton code de copy tient sur une ligne.
Bonjour rvtoulon
je tente je te tiens au courant
ReBonjour rvtoulon,
On y est presque, on touche au but, cette fois j'ai un petit message d'erreur à la lecture de la ligne
C'est bête parce-que toutes les cellules sont identiques en terme en mise en forme.
En PJ le message d'erreur.
Vous trouverez aussi un classeur excel avec l'exact mise en forme que j'utilise dans mes dossiers.
avec 2 cellules simplement fusionnées.
Merci
Bonjour,
voila comment je ferais pour copier les cellules fusionnées:
Dim sh As Worksheet
Dim c As Range
i = 1
For Each sh In Worksheets 'je parcours chaque feuille du classeur
If sh.Name = "onglet_" & i Then 'si le nom de la feuille correspond à "onglet"_i alors
y = 16
For Each c In sh.Range("H16:H23") 'je parcours chaque cellule de ma plage
If c.MergeCells Then ' je teste si la cellule est fusionnée, si oui copie toute la cellule fusionnée
c.MergeArea.Copy Workbooks(dossier_en_cours).Sheets("onglet_" & i).Range("H" & y)
i = i + 1
y = y + 1
End If
Next c
End If
Next shBonjour,
ça y est, cela fonctionne.
rvtoulon, j'ai utilisé mon ancien code du type :
Sheets("onglet_" & i).Range("H16:H23").Copy
Workbooks(dossier_en_cours).Activate
Sheets("onglet_" & i).Select
Range("H16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(reference).ActivateJ’avoue qu'il n'est pas "perfectionné", mais il me copie bien cellules fusionnées.
J'y ai insérer la fonction For/Each que tu m'as conseillé
i = 1
For Each sh In Worksheets
If sh.Name = "onglet_" & i Then
Sheets("onglet_" & i).Range("H16:H23").Copy
Workbooks(dossier_en_cours).Activate
Sheets("onglet_" & i).Select
Range("H16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(reference).Activate
i = i + 1
End If
Next shLe code fonctionne.
Je garde en précieuse note le derniers code que tu m'as fourni, rvtoulon.
mais je veux d'abord l'étudier et le comprendre.
je l'intégrerai et je te tiendrai au courant.
Merci à vous tous.