Re : macro à partir de plusieurs onglets pour concatener cellules
Bonjour Robert,
Je ne comprends pas pourquoi, c'est étrange...
Je te propose te coller directement le code dans le corps du message :
J'en suis là de mon code, qui fonctionne bien !
Mais parfois les "packs" sont séparés par des lignes vides dans les 4 feuilles sources de mon vrai fichier.
Serait-il possible, dans la feuille de résultat, d'
effacer ces lignes vides afin de ne présenter que les non vides ?
Par exemple, dans la feuille 1, on peut avoir :
Nom du pack
aa
bb
rien
rien
rien
cc
rien
dd
Voici mon code, avec les quelques modif que j'ai faites :
Option Explicit
Sub perfect_steering()
Dim I As Integer
Dim J As Long
Dim K As Byte
Dim F As Byte
Dim Lg As Long
Dim Msg As String
Dim Titre
Dim ColDep
Dim ColFin
Dim Cel As Range
Application.ScreenUpdating = False
Titre = Array("Read permission on activity planning", "Write permission on activity planning", "Read permission on synchronisation parts", "Write permission on synchronisation parts")
ReDim ColDep(UBound(Titre))
ReDim ColFin(UBound(Titre))
Lg = Range("A" & Rows.Count).End(xlUp).Row + 1
If Lg > 6 Then
Range("A6:E" & Lg).ClearContents
End If
Lg = 6
For F = 13 To 16
With Sheets(F)
For I = 0 To UBound(Titre)
Set Cel = .Rows(11).Find(what:=Titre(I), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
ColDep(I) = Cel.Column
J = Cel.Column
While .Cells(11, J).MergeCells = True And .Cells(11, J + 1) = ""
J = J + 1
Wend
ColFin(I) = J
Else
MsgBox "Incorrect data format in the sheet " & .Name
Exit Sub
End If
Next I
For J = 14 To .Range("C" & .Rows.Count).End(xlUp).Row
If .Range("D" & J) <> "" Then
For K = 0 To UBound(ColDep)
Msg = ""
For I = ColDep(K) To ColFin(K)
If .Cells(J, I) <> "" And UCase(.Cells(J, I)) <> "OK" And UCase(.Cells(J, I)) <> "KO" Then
Msg = Msg & .Cells(J, I) & ","
End If
Next I
If Len(Msg) > 0 Then
Cells(Lg, "A") = .Range("C" & J)
Cells(Lg, 2 + K) = Left(Msg, Len(Msg) - 1)
End If
Next K
Lg = Lg + 1
End If
Next J
End With
Next F
Columns("A:E").AutoFit
End Sub
A ta disposition s'il te faut des éclaircissements ^^
Encore un grand merci
Pierrot