XL 2016 Chercher valeur dans plusieurs feuilles et recopier les lignes dans une seule feuille - Macro VBA

jo77

XLDnaute Nouveau
Bonjour à vous, je sollicite votre aide dans le cadre d'une macro.

J'aimerai pouvoir créer une macro qui va avoir le fonctionnement suivant :

Dans chaque onglet finissant par "_CL"
Rechercher les lignes qui comprennent le mot "Etape"
Et recopier la ligne entière correspondante dans la feuille "Concatener" à partir de la ligne 2
Laisser une ligne vide entre chaque copie d'onglet.

Sachant, qu'au fur et à mesure du temps, de nouveaux onglets peuvent être créer
(Toujours finissant par "_CL" et ayant la même disposition)

Je vous joins le fichier.

Je débute en VBA donc si des commentaires peuvent être insérés pour les grosses fonctions.
Cela me permettrait de comprendre le code et de ne pas le copier bêtement. Et ainsi pouvoir le faire évoluer au cas où.

Merci grandement à vous, les génies d'Excel :)
 

Pièces jointes

  • Help.xlsm
    772 KB · Affichages: 11

jo77

XLDnaute Nouveau
Bonjour à vous,
Pour ceux que ça intéresse, voici le code que j'ai pu faire pour répondre à mon besoin.

Code:
'------------------------------------------------------------------------------------------ Reporte les Etapes dans l'onglet concatener

Sub Test()

Dim sht As Worksheet
Dim DerligSrc
Dim iDst As Integer
Set WsDst = Sheets("Concatener")

iDst = 2

WsDst.Range("Gantt_Tableau").ClearContents

 For Each sht In ThisWorkbook.Worksheets
    If sht.Name Like "*_CL" Then 'Cherche les onglets qui finissent par _CL
        For i = 8 To 1000
            If sht.Range("C" & i) Like "*Etape*" Then
                'MsgBox (sht.Range("C" & i) & " " & sht.Range("C" & i) & " " & WsDst.Name)
                WsDst.Range("A" & iDst) = sht.Range("A" & i)
                WsDst.Range("B" & iDst) = sht.Range("B" & i)
                WsDst.Range("C" & iDst) = sht.Range("C" & i)
                WsDst.Range("D" & iDst) = sht.Range("D" & i)
                WsDst.Range("E" & iDst) = sht.Range("E" & i)
                WsDst.Range("F" & iDst) = sht.Range("F" & i)
                WsDst.Range("G" & iDst) = sht.Range("G" & i)
                WsDst.Range("H" & iDst) = sht.Range("H" & i)
                WsDst.Range("I" & iDst) = sht.Range("I" & i)
                WsDst.Range("J" & iDst) = sht.Range("J" & i)
                WsDst.Range("K" & iDst) = sht.Range("K" & i)
                WsDst.Range("L" & iDst) = sht.Range("L" & i)
                WsDst.Range("M" & iDst) = sht.Range("B5")
                iDst = iDst + 1
            End If
        Next i
        
        Call InsereLigne(iDst)
        iDst = iDst + 1

    End If
    
 Next

End Sub

'---------------------------------------------------------------------------------------- Ajoute des lignes blanches entre chaque référence

Public Function InsereLigne(Ligne As Integer) As Integer
 Dim sh As Worksheet
 Set sh = Sheets("Concatener")
 While sh.Cells(Ligne, 14) <> ""
  If sh.Cells(Ligne - 1, 14) <> sh.Cells(Ligne, 14) Then
    sh.Cells(Ligne, 1).EntireRow.Insert Shift:=xlShiftDown
    Ligne = Ligne + 1
  End If
 Ligne = Ligne + 1
 Wend
End Function
 

Discussions similaires