Probleme de boucle Excel VBA colonne

Bonjour, au vue des sujets traités j'ai peur que mon sujet vous semble leger...

je patauge depuis quelques temps sur un problème peut être simple...

Voila, je souhaite que pour chaque feuille de ma sélection de feuille (de feuil2 à derniere feuille) je puisse copier les valeurs de la colonne D et les coller sur la feuille 1 du même classeur. Mon problème c'est que je n'arrive pas a écrire le décalage attendu de mes collage sur la feuille 1... Pour être plus clair la procédure doit faire:

Copier la colonne D de la feuille (2), coller dans la colonne D feuille(1)

Copier la colonne D de la feuille (3), coller dans la colonne E (soit D décalé de 1) de la feuille (1)

et ainsi de suite jusqu’à la fin de mes feuilles.

Je ne sais pas par avance le nombre de feuille de mon classeur...

Alors j'ai tenté plein de chose mais je suis perdu complet. J'ai bien utilisé l'enregistreur de macro mais je n'arrive pas a creer cette satané boucle pour incrémenter mes colonnes de ma feuille 1 les unes a coté des autres.

Au Secours et merci par avance

Bonsoir,

un coup de pouce histoire de peut être te débloquer.

ActiveWorkbook.Sheets.Count

te permettra de savoir cb tu as d'onglet dans ton classeur après une petite boucle pourra surement t'aider également.

Bonjour à tous

Un essai à tester. Te convient-il ?

Bye !

Merci pour vos réponses... Je ne pourrais tester ça que lundi mais je vais me efforcer de décortiquer tout ça et dresser une statut à vos noms respectif si ça fonctionne... Je vous tiens au courant le plus vite possible

Merci encore

Bonjour,

Un exemple dans le fichier joint.

ALT F8, exécuter la procédure Copy_Data.

Cdlt

Public Sub Copy_Data()
Dim wb As Workbook
Dim ws As Worksheet, wsCible As Worksheet
Dim rCell As Range
Dim N As Long
    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    Set wsCible = wb.Worksheets("Consolidation")
    Set rCell = wsCible.Cells(2, 4)
    rCell.CurrentRegion.ClearContents
    For Each ws In wb.Worksheets
        If ws.Name <> wsCible.Name Then
            N = ws.Cells(Rows.Count, 4).End(xlUp).Row
            ws.Cells(2, 4).Resize(N - 1).Copy Destination:=rCell
            Set rCell = rCell.Offset(, 1)
        End If
    Next ws
End Sub

Bonjour, Je suis passé au travail ce matin spécialement pour tester vos codes.

Ça marche super bien...

 
      If ws.Name <> wsCible.Name Then
      ...
          ws.Cells(2, 4).Resize(N - 1).Copy Destination:=rCell
            Set rCell = rCell.Offset(, 1)

  

Ou

    If f.Name <> fa.Name Then
    ...
    f.Range("D1:D" & derln).Copy fa.Cells(1, 4 + k)
            k = k + 1

Voici les parties que je n'arrivais pas à écrire. Vous avez été d'un grand secours.

Vous êtes des seigneurs, merci BigDaddy, Gmb et Jean Eric