Créer une boucle
Résolu/Fermé
A voir également:
- Créer une boucle
- Créer un compte gmail - Guide
- Créer un compte google - Guide
- Créer une liste déroulante excel - Guide
- Créer un groupe whatsapp - Guide
- Créer une adresse hotmail - Guide
2 réponses
yg_be
Messages postés
22697
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 avril 2024
1 471
Modifié le 22 oct. 2019 à 16:01
Modifié le 22 oct. 2019 à 16:01
bonjour, eux-tu préciser le type "basic" quand tu emploies les balises de code pour partager du VBA?
ci-dessous une suggestion, si j'ai bien compris. la boucle s’arrête quand elle rencontre un contenu vide en ligne 2.
J'ai supposé que la ligne avec les noms d'onglets était dans la feuille "00.Secrétariat". Sinon, change la ligne de code
ci-dessous une suggestion, si j'ai bien compris. la boucle s’arrête quand elle rencontre un contenu vide en ligne 2.
Dim Im As String, col As Long, fsec As Worksheet Application.ScreenUpdating = False Set fsec = Sheets("00.Secrétariat") col = 3 Im = fsec.Cells(2, col).Value Do While Im <> "" Sheets(Im).Range("B22:B52").Copy Sheets("00.Secrétariat").Cells(8, col).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(Im).Range("AH20").Copy Sheets(Im).Range("AJ8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("00.Secrétariat").Cells(4, col).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("00.Secrétariat").Cells(2, col).Select col = col + 1 Im = fsec.Cells(2, col).Value Loop Application.CutCopyMode = False Application.ScreenUpdating = True
J'ai supposé que la ligne avec les noms d'onglets était dans la feuille "00.Secrétariat". Sinon, change la ligne de code
fsec=
ThauTheme
Messages postés
1442
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
29 juillet 2022
160
22 oct. 2019 à 16:07
22 oct. 2019 à 16:07
Bonjour Pirate, bonjour le forum,
Peut-être comme ça :
Peut-être comme ça :
Sub Macro1() Dim OS As Worksheet Dim OD As Worksheet Dim C As Range Dim O As Worksheet Dim Im As String Dim COL As Integer Application.ScreenUpdating = False Set OS = ActiveSheet Set OD = Worksheets("00.Secrétariat") COL = 3 For Each C In OS.Range(OS.Cells(2, "C"), OS.Cells(Application.Rows.Count, "C").End(xlUp)) Im = C.Value Sheets(Im).Range("B22:B52").Copy OD.Cells(8, COL).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(Im).Range("AH20").Copy Sheets(Im).Range("AJ8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False OD.Cells(4, COL).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False OD.Activate OD.Cells(2, COL).Select Application.CutCopyMode = False COL = COL + 1 Application.ScreenUpdating = True End Sub
22 oct. 2019 à 16:21
Merci!