Discussion :

[Mairequimby]

Bonjour,

J'ai des soucis avec une Macro. Je désire que la macro cherche les cellules débutant par Dossier* dans la colonne B. Si il trouve une telle cellule, je veux qu'il prenne les 4 prochaines cellules de D

exemple, si on est en B4, je désire que la macro copie les cellules D5 à D9

ensuite ces cellules copié doivent être transposé dans la première ligne disponible d'une autre feuille. Le processus doit être répété jusqu'à ce qu'il n'y ait plus de cellule en B débutant par Dossier*

Voici mon essaie. Je réussi à copier, mais pas à coller dans une autre feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
For M = 1 To Range("B65536").End(xlUp).Row
    If Cells(M, 2) Like "Dossier*" Then Range(Cells(M + 1, 4), Cells(M + 5, 4)).Select
    Selection.Copy
 
 
   Sheets("Feuil1").Select
    Range("A1").End(xlDown).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        Application.CutCopyMode = False
 Next

Merci beaucoup

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim m As Long, NewLig As Long
 
Application.ScreenUpdating = False
With Sheets("Feuil2")
    For m = 1 To .Range("B" & .Rows.Count).End(xlUp).Row
        If .Cells(m, 2) Like "Dossier*" Then
            With Sheets("Feuil1")
                NewLig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            End With
            Sheets("Feuil1").Range("A" & NewLig & ":E" & NewLig).Value = Application.Transpose(.Range("D" & m + 1 & ":D" & m + 5).Value)
        End If
    Next m
End With

[Mairequimby]

Merci beaucoup, ca fonctionne à merveille. Je venais juste de trouver, mais ma solution est beaucoup moins esthétique et performante que la tienne.

Merci!