XL 2016 Macro copier coller à la suite

[Erakmur]

Bonjour,
J'aimerai une macro qui me donne le résultat de l'onglet résultat par rapport à l'onglet feuille 1.
Comment obtient ton l'onglet résultat :
Dans la colonne photo 1, filtrer sur les cases non vides, copier coller colonne A, B et C en colonne A de la colonne résultat
Dans la colonne photo 2, filtrer sur les cases non vides, copier coller colonne A, D et E en colonne A de la colonne résultat à la suite du résultat de la colonne photo 1
Dans la colonne photo 3, filtrer sur les cases non vides, copier coller colonne A, F et G en colonne A de la colonne résultat à la suite du résultat de la colonne photo 2
Et ce que cela est possible ?

 

[Phil69970]

Bonjour @Erakmur

Je te propose ce fichier

*Merci de ton retour

@Phil69970

 

[Erakmur]

Merci. Apriori ça à l'ait de fonctionner. Je le testerai en condition réelle dans quelques jours. La colonne et le nom des colonnes sont déférents ainsi que le nom des onglets mais il suffit je pense de changer cela dans ta macro. Je te tiens au courant

 

[Phil69970]

Re

C'est pas grave .....

La colonne et le nom des colonnes sont déférents

..... sauf si les colonnes ne sont pas les mêmes

Si le codeName est différents de celui déclaré il y aura un pb

ainsi que le nom des onglets

Si le codeName est dans ton fichier respectivement Feuil1 et Feuil2 comme dans ton fichier exemple tout ira bien sinon il faudra ajuster
*Le nom apparent ici Feuil1 et Résultat peuvent être changer sans pb.

D’où l’intérêt de mettre un fichier représentatif
Un fichier représentatif de 10 à 20 lignes avec tes attendus (avant/après) ET respectant le RGPD permettrait de comprendre le problème et de t'apporter une ou des réponses.

C'est quoi représentatif ?
- représentatif, même organisation des lignes et des colonnes, mêmes libellés, mêmes noms de feuilles...
- anonymisé, pas de données personnelles réelles tels nom, n° sécu, adresse ...
- simplifié, une quinzaine de lignes reproduisant l'ensemble des différents cas envisageables

*Éventuellement préciser l'ordre de grandeur des lignes à traiter, exemple mon fichier comporte 1 000 lignes ou bien 20 000 lignes ==> la méthodologie peut être différents.

@Phil69970

 

[job75]

Bonsoir Erakmur,

Voyez le fichier joint et la macro dans la feuille "Résultat" :

Private Sub Worksheet_Activate()
Dim tablo, ub&, resu(), col%, i&, n&
tablo = Sheets("Feuil1").[A1].CurrentRegion.Resize(, 7) 'matrice, plus rapide
ub = UBound(tablo)
ReDim resu(1 To 3 * ub, 1 To 3)
For col = 2 To 6 Step 2
    For i = 2 To ub
        If tablo(i, col) & tablo(i, col + 1) <> "" Then
            n = n + 1
            resu(n, 1) = tablo(i, 1)
            resu(n, 2) = tablo(i, col)
            resu(n, 3) = tablo(i, col + 1)
        End If
Next i, col
'---resy=titution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
Columns.AutoFit 'ajuste les largeurs
End Sub

Elle se déclenche quand on active la feuille.

L'exécution est très rapide car on utilise des tableaux VBA.

A+

 

[Erakmur]

Ok je vois. Je vais donc te donner le fichier original en pièce jointe.
Feuil1 = 2. Relevé Equipem. Prise en ch.
Résultat = Multimed
Colonne A = Colonne G
Colonne B = Colonne AQ
Colonne C = Colonne AR
Colonne D = Colonne AS
Colonne E = Colonne AT
Colonne F = Colonne AU
Colonne G = Colonne AV

Je test ta macro Job75.

 

[Erakmur]

Bonsoir Erakmur,

Voyez le fichier joint et la macro dans la feuille "Résultat" :

Private Sub Worksheet_Activate()
Dim tablo, ub&, resu(), col%, i&, n&
tablo = Sheets("Feuil1").[A1].CurrentRegion.Resize(, 7) 'matrice, plus rapide
ub = UBound(tablo)
ReDim resu(1 To 3 * ub, 1 To 3)
For col = 2 To 6 Step 2
    For i = 2 To ub
        If tablo(i, col) & tablo(i, col + 1) <> "" Then
            n = n + 1
            resu(n, 1) = tablo(i, 1)
            resu(n, 2) = tablo(i, col)
            resu(n, 3) = tablo(i, col + 1)
        End If
Next i, col
'---resy=titution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
Columns.AutoFit 'ajuste les largeurs
End Sub

Elle se déclenche quand on active la feuille.

L'exécution est très rapide car on utilise des tableaux VBA.

A+

Comment je fais pour l'adapter à ma matrice. Je ne vois pas les nom des colonnes pour les changer ?

Ok je vois. Je vais donc te donner le fichier original en pièce jointe.
Feuil1 = 2. Relevé Equipem. Prise en ch.
Résultat = Multimed
Colonne A = Colonne G
Colonne B = Colonne AQ
Colonne C = Colonne AR
Colonne D = Colonne AS
Colonne E = Colonne AT
Colonne F = Colonne AU
Colonne G = Colonne AV

Je test ta macro Job75.

 

[job75]

Bonsoir,

Je répondrai quand vous fournirez un fichier non vide et qui s'ouvre sans bug

Bonne nuit.

 

[job75]

Bon voici la macro adaptée :

Private Sub Worksheet_Activate()
Dim tablo, ub&, resu(), col%, i&, n&
With Sheets("2. Relevé Equipem. Prise en ch.")
    tablo = .Range("A3:AV" & .Cells.SpecialCells(xlCellTypeLastCell).Row) 'matrice, plus rapide
    ub = UBound(tablo)
    ReDim resu(1 To 3 * ub, 1 To 3)
    For col = .[AQ3].Column To .[AV3].Column Step 2
    For i = 2 To ub
        If tablo(i, col) & tablo(i, col + 1) <> "" Then
            n = n + 1
            resu(n, 1) = tablo(i, 7)
            resu(n, 2) = tablo(i, col)
            resu(n, 3) = tablo(i, col + 1)
        End If
Next i, col
End With
'---resy=titution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
Columns.AutoFit 'ajuste les largeurs
End Sub

 

[Erakmur]

Bonjour,
Voilà le fichier sans bug. Dans ta macro, je ne vois pas le nom de l'onglet de la feuille de résultat appelé Multimed. Du coup, je ne pas la tester. Ou l'indique t'on ?
Cordialement

 

[job75]

Bonjour,

La macro est évènementielle et doit être placée dans la feuille des résultats "Multimed".

Il n'est donc pas nécessaire d'indiquer le nom de la feuille des résultats.

A+

 

[Erakmur]

J'ai testé est ça fonctionne ! Il y a néanmoins un cas de figue que je n'ai pas prévu. Quand il y a un commentaire sans photo ta macro affiche le résultat hors elle ne devrait rien afficher. Cela concerne dans cet exemple les lignes 80, 81 et 82.
De plus, Si je dois un jour rajouter des colonnes Photo anomalie 4 et Commentaire photo 4 après la colonne AV, ta macro est elle facile à modifier ? Si oui comment ?

 

[job75]

Quand il y a un commentaire sans photo ta macro affiche le résultat hors elle ne devrait rien afficher.

Alors il ne devrait pas y avoir de commentaire sans photo, mon code permet de voir qu'il y a une erreur.

Mais si vous y tenez absolument il est facile de comprendre qu'il suffit de remplacer :

If tablo(i, col) & tablo(i, col + 1) <> "" Then

par :

If tablo(i, col) <> "" Then

Et si vous voulez ajouter 2 colonnes AW et AX remplacez AV par AX dans la macro (2 endroits).

 

[Erakmur]

Bonjour,
Tout à l'air de bien fonctionner. Je vous remercie pour votre aide.