Créer une boucle
Résolu/Fermé
A voir également:
- Créer une boucle
- Créer une adresse mail - Guide
- Créer un compte gmail - Guide
- Créer une liste déroulante excel - Guide
- Créer un compte google - Guide
- Créer un compte instagram - Guide
2 réponses
yg_be
Messages postés
21303
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 mars 2023
1 326
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!