Importer des données d'autres feuilles si condition

Bonjour à tous,

Je suis débutant débutant sur VBA et Excel, je ne sais faire que des choses basiques mais je cherche à m'améliorer.

Je vous explique mon problème:

Je travaille sur un fichier d'analyse de risque en entreprise par poste de travail. En remplissant des cases à l'aide d'une liste ça nous donne une information : Si le risque est tolérable, Significatif, Intolérable etc...

Je souhaiterais faire une fiche de synthèse qui reprend chaque ligne ou le risque (après moyen de prévention) est TOUJOURS significatif ou intolérable.

En gros aller chercher sur chaque feuille la condition Si c'est un risque trop élevé et l'afficher dans la synthèse (mais attention je n'ai pas besoin des infos de toutes les colonnes).

Je n'y connais pas grand chose alors je galère... Je ne sais pas si je me complique la vie comme ça

C'est clair dans ma tête mais je ne sais pas si je le suis vraiment, ca le sera peut être un peu plus avec le fichier.

Je vous remercie par avance de toute les réponses, indications que vous pourrez m'apporter.

Cordialement,

MartinL

Bonjour MartinL,

voici un exemple,

le fait de fusionner les cellules des lignes 3,4 et 5 de la feuille "Synthèse" complique la tache pour trouver la dernière cellule de cette feuille, c'est pour cette raison que j'ai commencé la macro avec:

Sheets("Synthèse").Range("A6:G5000").ClearContents
sh1LastRow = 6

une fois la 1er boucle terminé et la première inscription fait, là il a été possible de trouver la dernière cellule

sh1LastRow = sh1.Cells(Rows.Count, 2).End(xlUp).Row + 1

perso j'évite les cellules fusionnées,

Sub Bouton1_Cliquer()
Dim sh1, sh, Source, Destin
Dim sh1LastRow As Long, shxLastRow As Long
Dim i As Long, y As Integer
Set sh1 = Sheets("Synthèse")
Sheets("Synthèse").Range("A6:G5000").ClearContents
sh1LastRow = 6

'Source = numéro de colonne à copier,
'Destin = numéro de colonne de destination des données
Source = Array(1, 2, 9, 22, 25)
Destin = Array(2, 3, 6, 7, 10)

For Each sh In Worksheets
  If Left(sh.Name, 5) = "Poste" Then
'  nn = sh.Name
    shxLastRow = Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Row
    For i = 8 To shxLastRow
      If Sheets(sh.Name).Cells(i, 22) Like "*Intolérable*" Or Sheets(sh.Name).Cells(i, 22) Like "*Significatif*" Then
       sh1.Cells(sh1LastRow, 1).Value = sh.Name
       For y = 0 To 4
        sh1.Cells(sh1LastRow, Destin(y)).Value = Sheets(sh.Name).Cells(i, Source(y)).Value
       Next
      End If
     sh1LastRow = sh1.Cells(Rows.Count, 2).End(xlUp).Row + 1
    Next
  End If
Next
End Sub

Bonjour,

Autre essai, à voir :

Sub Synthèse()
    Dim Ts(), k, r%, i%, j%, n%, ws As Worksheet
    k = Array(1, 2, 7, 8, 9, 22, 25)
    For Each ws In Worksheets
        If ws.Name Like "Poste*" And ws.Range("C3") <> "" Then
            With ws
                n = .Cells(.Rows.Count, 1).End(xlUp).Row
                If n > 7 Then
                    For i = 8 To n
                        If .Cells(i, 22) Like "*Intol*" Or .Cells(i, 22) Like ("*Signif*") Then
                            ReDim Preserve Ts(7, r)
                            For j = 0 To 6
                                Ts(j + 1, r) = .Cells(i, k(j))
                            Next j
                            Ts(0, r) = .Range("C3"): r = r + 1
                        End If
                    Next i
                End If
            End With
        End If
    Next ws
    With Worksheets("Synthèse")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        If n > 4 Then .Range("A5:J" & n).ClearContents
        .Range("A5").Resize(r, 8).Value = WorksheetFunction.Transpose(Ts)
    End With
End Sub

Bonjour !

Merci beaucoup beaucoup à vous deux pour cette rapidité de réponse.

Vos codes fonctionnent

Que dire de plus à part MERCI ?

J'ai bidouiller un peu le votre mFerrand (j'utilise celui là) histoire de pouvoir rajouter la colonne "danger" aussi.

Je vous souhaite a tout les deux une agréable fin de semaine,

merci encore.

Martin

Bonjour,

histoire de pouvoir rajouter la colonne "danger"

En colonne masquée... ?

Bonne journée.