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.