Créer une boucle

Résolu/Fermé

Pirate - Modifié le 22 oct. 2019 à 15:38
Pirate - 22 oct. 2019 à 16:21

Bonjour,

J'ai besoin de votre aide pour créer un boucle.

Pour le moment, l'utilisateur sélectionne la colonne qui porte le nom d'une feuille et le sub.

Application.ScreenUpdating = False

Dim Im As String
Dim col As Long
Im = ActiveCell.Value
col = ActiveCell.Column

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
Application.CutCopyMode = False

Application.ScreenUpdating = True

Cela récupère différentes données sur la feuille en question et les copies dans la feuille 00.secrétariat. dans la colonne X.

Il a plusieurs feuilles X. J'aimerais que l'utilisateur est la possibilité de récupérer toutes les données d'un coup.

Les colonnes qui reçoivent les données vont de la colonne numéro 3 (C) à la colonne " Sheets.count"-2 (elles sont variables car on peut en rajouter).

La ligne 2 à partir de la colonne C contient le nom des onglets.

J'essaye depuis un moment de créer cette boucle mais ça dépasse mes compétences en VBA...

D'avance merci pour votre aide!!!!

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

Réponse 1 / 2

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

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.

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=

Pirate
22 oct. 2019 à 16:21

Un grand merci ça fonctionne parfait!
Merci!

Réponse 2 / 2

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

Bonjour Pirate, bonjour le forum,

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

Discussions similaires

créer une adresse gmail pour une autre personne

Mon pc s'allume et s'éteint en boucle

Discussions similaires

Newsletters