Copie de différentes cellules situées dans plusieurs feuilles

Bonjour à tous,

J'aurais besoin qu'on m'aide à concevoir un code VBA afin de permettre la copie de différentes cellules situées dans plusieurs feuilles dans une seule feuille.

Pour chaque feuille (noms variés) située à droite de la feuille BDIST, copier dans la feuille BDIST, les cellules (les valeurs) AH27 à BT27 si AL27 n’égale pas 0, AH39 à BT39 si AL39 n’égale pas 0, AH51 à BT51 si AL51 n’égale pas 0, etc, jusqu’à AL___ égale 0. Après passer à l’autre feuille et faire la même chose en copiant les cellules à la suite de celles précédemment copiées jusqu’à la dernière feuille.

Le résultat des copies est représenté dans la feuille BDIST_RESULTATS.

Je joins le fichier "Fichier test.xlsm".

En vous remerciant par avance pour votre précieuse aide.

Salutations,

Renaud D.

Bonjour,

les cellules (les valeurs) AH27 à BT27 si AL27 n’égale pas 0, AH39 à BT39 si AL39 n’égale pas 0,.....

Vous êtes sûr que ce n'est pas AM plutôt que AL dans votre fichier ?

N'y a-t-il pas un titre dans chaque colonne de la feuille résultats qui doit être ajouté ?

Cordialement

Bonsoir Dan,

Merci pour votre aide. Les cellules AL27, AL39, ... font référence au contenu des cellules T27, T39,... Si aucune donnée n'est présente dans un des champs T__ (AL___) alors on passe à la prochaine feuille, et ainsi de suite jusqu'à la dernière feuille. Les titres dans la feuille BDIST pourront être ajoutés ultérieurement.

Au plaisir de vous lire,

Cordialement

Renaud D.

Si aucune donnée n'est présente dans un des champs T__ (AL___)

Ce n'est plus la même chose que ce que vous écriviez dans le premier post çà....
AL contient du texte donc cela peut être interprété autrement par excel que 0
D'où ma question

Essayez avec ce code

Sub test()
Dim i As Byte
Dim dlg As Integer
Dim sh As Worksheet

For Each sh In Sheets
    If sh.Name Like "*MUR*" Then
        For i = 27 To 51 Step 12
            If Sheets(sh.Name).Range("AL" & i) <> 0 Then
                With Sheets("BDIST_RESULTATS")
                    dlg = .UsedRange.Rows.Count + 1
                    .Range("A" & dlg).Resize(, 39) = Sheets(sh.Name).Range("AH" & dlg & ":BT" & i).Value
                End With
            End If
        Next i
    End If
Next sh
End Sub

Autre point : j'ai vu que vous avez des codes dans chaque feuille. Là cela risque de se compliquer à la longue
Sachez que l'on peut réduire et ne les mettre qu'une seule fois dans le fichier
Dites moi si vous voulez que je regarde ce point

J'ai essayé votre macro et rien n'est copié dans la feuille"BDIST" (voir fichier : "Fichier_test_2.xlsm ci-joint"). L'erreur est peut-être de mon côté ? La feuille "BDIST_RESULTATS" représente uniquement les résultats de la copie des différences cellules dans la feuille "BDIST". Les données doivent être copiées dans la feuille "BDIST". J'ai oublié de préciser que les cellules AH27, AH39,... peuvent contenir une valeur différente du mot "MUR". Les cellules AH27, AH39,... peuvent contenir la valeur "MUR", "PLANCHER", "PLAFOND",...

Edit modo : supprimé fichier

La feuille "BDIST_RESULTATS" représente uniquement les résultats de la copie des différences cellules dans la feuille "BDIST".
L'erreur est peut-être de mon côté ?

Non.
Logique puisque la feuille mentionnée dans le code n'est pas BDIST.

Prenez le code comme ceci

Sub test()
Dim i As Byte
Dim dlg As Integer
Dim Sh As Worksheet

For Each Sh In Sheets
    If Sh.Name Like "*MUR*" Then
        For i = 27 To 51 Step 12
            If Sheets(Sh.Name).Range("AL" & i) <> 0 Then
                With Sheets("BDIST")
                    dlg = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & dlg).Resize(, 39) = Sheets(Sh.Name).Range("AH" & i & ":BT" & i).Value
                End With
            End If
        Next i
    End If
Next Sh
End Sub

J'ai oublié de préciser que les cellules AH27, AH39,... peuvent contenir une valeur différente du mot "MUR".

Ok j'ai vu dans vos feuilles "MUR" mais aucune importance par rapport à votre demande.

NB : Je n'avais pas besoin de votre fichier concernant le code puisque j'ai le votre pour tester. Je l'ai supprimé

Crdlt

Merci beaucoup Dan pour votre aide.

Votre macro fonctionne très bien. C'est exactement ce que je voulais.

Je vous souhaite une bonne soirée.

Salutations,

Renaud D.