macro à partir de plusieurs onglets pour concatener cellules

[pierrot_42]

Bonjour cher Forum,

J'utilise une macro pour aller chercher des valeurs sur une feuille, les concatener et les coller dans une autre.

Je voudrais maintenant que la macro aille chercher ces valeurs dans plusieurs onglets, les concatène et les colle dans un onglet. Mais j'ai un message d'erreur

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

screenshot message d'erreur macro
Cijoint.fr - Service gratuit de dépôt de fichiers

J'utilise la macro suivante :


Option Explicit

Sub perfect_steering()
Dim I As Integer
Dim J As Long
Dim K As Byte
Dim Lg As Long
Dim Msg As String
Dim ColDep
Dim ColFin

ColDep = Array(5, 35, 47, 50)
ColFin = Array(34, 46, 49, 61)

Lg = 4

If Range("A1") <> "" Then
Lg = Range("A" & Rows.Count).End(xlUp).Row
End If

For aze = 1 To 4

With Sheets(I)
For J = 11 To .Range("A" & .Rows.Count).End(xlUp).Row
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, 2 + K) = Left(Msg, Len(Msg) - 1)
End If
Next K
Lg = Lg + 1
Next J
End With

Next aze

Columns("B:E").AutoFit
End Sub

Merci d'avance pour votre aide !

Cordialement,

Pierrot

 

[Robert]

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...

 

[pierrot_42]

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

 

[flyonets44]

Re : macro à partir de plusieurs onglets pour concatener cellules

Bonjour
Dim I as Long, Aze as long
Cordialement
Flyonets

 

[Robert]

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.

 

[pierrot_42]

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 --

 

[Robert]

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...

 

[pierrot_42]

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