macro à partir de plusieurs onglets pour concatener cellules

Re : macro à partir de plusieurs onglets pour concatener cellules

Bonjour Peirrot, bonjour le forum,

Sans ouvrir ton fichier... Tu as opté pour Option Explicit
• la variable aze n'est ni déclarée ni définie...
• la variable I n'est pas définie, donc With Sheets(I) plante...

Re : macro à partir de plusieurs onglets pour concatener cellules

Bonjour Robert🙂

Merci d'avoir regardé. Je commence la vba, c'est un collègue qui a créé ce code, tu pourrais m'indiquer comment déclarer et définir aze, et définir I stp ?

Très cordialement,

Pierrot

Re : macro à partir de plusieurs onglets pour concatener cellules

Bonjour
Dim I as Long, Aze as long
Cordialement
Flyonets

Re : macro à partir de plusieurs onglets pour concatener cellules

Bonjour Pierrot, bonjour le forum,

Visiblement I est une variable qui sert plusieurs fois d'où la confusion... mais il me faudrait le fichier pour pouvoir t'aider d'avantage et je n'arrive pas à l'ouvrir. La première pièce jointe n'est pas un fichier Excel et dans la seconde j'ai vu que la ligne For I = 1 To 4 a été remplacée par For aze = 1 To 4. Voilà donc déja une erreur réparée... Mais tu boucles deux fois For I = ! Ça passe pas...
Je te propose de remettre ton fichier sur le site de téléchargement ou d'en faire une version épurée accessible ici.

Re : macro à partir de plusieurs onglets pour concatener cellules

Voici le lien du fichier simplifié qui contient la macro à corriger : 🙂

Cijoint.fr - Service gratuit de dépôt de fichiers


Sur chacun des 4 onglets, les données à concatener commencent en G14, il ne faut pas que la macro ne tienne pas compte des KO et des OK.

Autre contrainte, d'une feuille à l'autre, les "types" n'ont pas la même longueur, ils n'ont pas le même nombre de colonnes.

En revanche, il y a toujours 4 types par feuille, même s'ils sont de longueurs différentes. Il faut peut-être créer 4 ColDep / ColFin ?

Enfin, il faudrait que sur la feuille de résultat (appelée "result macro"), le nom du "pack" apparaisse dans la colonne A, à gauche des listes correspondantes.

J'espère qu'on y arrivera, je sens qu'on est vraiment près du but !

Merci beaucoup.

Bien cordialement,

-- Pierrot --

Re : macro à partir de plusieurs onglets pour concatener cellules

Bonjour Pierrot, bonjour le forum,

Voilà sur quoi je tombe quand je veux télécharger ton fichier :

J'ai beau chercher je ne trouve aucun fichier Excel...

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