VBA - mes cellules ne se copient pas

J'ai fait ce code mais les valeurs que je devrais avoir en cells(a, 5) et cells(a, 6) ne s'affichent pas dans la page souhaitez.

Comment faire ?

Merci

Sub essai()
'

'Trouve le nombre de feuilles dans le fichier

Dim NbFeuil As Long, Sh As Worksheet
NbFeuil = 0
For Each Sh In ActiveWorkbook.Worksheets
    NbFeuil = NbFeuil + Sh.HPageBreaks.Count + 1

a = 8

Next Sh

Dim i As Long

For i = 1 To NbFeuil

        Sheets(i).Select 'selectionne la feuille de la boucle

    If Range("A4").Value = "Dimensions extérieures" Then 'marche seulement pour les longueurs

        ActiveSheet.Range("F5").Copy
        Sheets("Résumé_panneaux").Select
        Cells(a, 4).PasteSpecial Paste:=xlPasteValues

        ActiveSheet.Range("G5").Copy
        Sheets("Résumé_panneaux").Select
        Cells(a, 5).PasteSpecial Paste:=xlPasteValues

        ActiveSheet.Range("H5").Copy
        Sheets("Résumé_panneaux").Select
        Cells(a, 6).PasteSpecial Paste:=xlPasteValues

        a = a + 1

    End If

        Application.Wait (Now + TimeValue("00:00:01")) 'ca sa sert à rien c'était juste pour tester le passage des feuilles

Next i

End Sub

UPDATE : J'ai réussi à résoudre le problème, par contre j'ai une erreur d'exécution 9 : l'indice n'appartient pas à la sélection.

Une aide ?

Bonjour

une erreur d'exécution 9 : l'indice n'appartient pas à la sélection.

Le code s'arrête sur quelle ligne ?

Sinon essayez comme ceci

Sub essai()
'Trouve le nombre de feuilles dans le fichier

Dim NbFeuil As Long, Sh As Worksheet

NbFeuil = 0
For Each Sh In ActiveWorkbook.Worksheets
    NbFeuil = NbFeuil + Sh.HPageBreaks.Count + 1
Next Sh

Dim i As Long
a = 8
For i = 1 To NbFeuil
    If Sheets(i).Range("A4").Value = "Dimensions extérieures" Then 'marche seulement pour les longueurs

        With ActiveSheet
            .Range("F5:H5").Copy
            Sheets("Résumé_panneaux").Cells(a, 4).PasteSpecial Paste:=xlPasteValues
            a = a + 1
        End With

    End If
    'Application.Wait (Now + TimeValue("00:00:01")) 'ca sa sert à rien c'était juste pour tester le passage des feuilles
Next i
End Sub

Cordialement

Comment je peux regarder sur quel ligne le problème se situe ?

Je pense qu'il s'agit de la dernière ligne avec Next i car les codes après ne s'exécute pas.

d'ailleurs petite amélioration du code :

Sub Actualiser()
'

'Trouve le nombre de feuilles dans le fichier
Dim NbFeuil As Long, Sh As Worksheet
NbFeuil = 0
For Each Sh In ActiveWorkbook.Worksheets
    NbFeuil = NbFeuil + Sh.HPageBreaks.Count + 1
Next Sh

Dim a As Long
a = 8

Dim i As Long

For i = 1 To NbFeuil

        Sheets(i).Select 'selectionne la feuille de la boucle

    If Range("A4").Value = "Dimensions extérieures" Then 'on fait ca quand on trouve le bon truc sinon dans les autres feuilles on fait rien

        Sheets(i).Select
        Range("C3").Copy                     'Désignation du produit
        Sheets("Résumé_Panneaux").Select
        Cells(a, 2).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("J4").Copy                     'Quantité
        Sheets("Résumé_Panneaux").Select
        Cells(a, 3).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("F5").Copy                     'Longueur
        Sheets("Résumé_Panneaux").Select
        Cells(a, 4).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("G5").Copy                     'Hauteur
        Sheets("Résumé_Panneaux").Select
        Cells(a, 5).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("H5").Copy                     'Epaisseur
        Sheets("Résumé_Panneaux").Select
        Cells(a, 6).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("O4").Copy                     'Surface unitaire
        Sheets("Résumé_Panneaux").Select
        Cells(a, 7).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("P4").Copy                     'Surface TOTAL
        Sheets("Résumé_Panneaux").Select
        Cells(a, 8).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("R4").Copy                     'Poids unitaire
        Sheets("Résumé_Panneaux").Select
        Cells(a, 9).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("S4").Copy                     'Poids TOTAL
        Sheets("Résumé_Panneaux").Select
        Cells(a, 10).PasteSpecial xlPasteValues

        Sheets(i).Select
        Range("C1").Copy                     'Nom de l'affaire
        Sheets("Résumé_Panneaux").Select
        Cells(2, 4).PasteSpecial xlPasteValuesAndNumberFormats

        Sheets(i).Select
        Range("C2").Copy                     'Numéro du dossier
        Sheets("Résumé_Panneaux").Select
        Cells(3, 4).PasteSpecial xlPasteValuesAndNumberFormats

        a = a + 1

    End If

Next i

Sheets(Résumé_Panneaux).Select

MsgBox "Actualisation terminée, vous pouvez poursuivre !", vbInformation, "Actualisation"

End Sub

d'ailleurs petite amélioration du code :

Non justement. Je vous simplifie votre code et vous enlève tous les select (à éviter avec VBA). Vous les remettez...

J'imagine que vous n'avez pas testé ce que je vous ai donné

Edit : cette partie de code pourrait devenir ceci

For i = 1 To NbFeuil
    With Sheets(i)
        If .Range("A4").Value = "Dimensions extérieures" Then

            Sheets("Résumé_Panneaux").Cells(a, 2) = .Range("C3").Value
            Sheets("Résumé_Panneaux").Cells(a, 3) = .Range("J4").Value
            Sheets("Résumé_Panneaux").Cells(a, 4) = .Range("F5").Value
            Sheets("Résumé_Panneaux").Cells(a, 5) = .Range("G5").Value
            Sheets("Résumé_Panneaux").Cells(a, 6) = .Range("H5").Value
            Sheets("Résumé_Panneaux").Cells(a, 7) = .Range("O4").Value
            Sheets("Résumé_Panneaux").Cells(a, 8) = .Range("P4").Value
            Sheets("Résumé_Panneaux").Cells(a, 9) = .Range("R4").Value
            Sheets("Résumé_Panneaux").Cells(a, 10) = .Range("S4").Value

            .Range("C1:C2").Copy
            Sheets("Résumé_Panneaux").Cells(2, 4).PasteSpecial xlPasteValuesAndNumberFormats
            '.Range("C2").Copy
            'Sheets("Résumé_Panneaux").Cells(3, 4).PasteSpecial xlPasteValuesAndNumberFormats

            a = a + 1
        End If
    End With
Next i

c'est sur votre code fait vachement plus professionnel (sans me moquer)

Mais je ne peux pas essayer votre code car je suis en entreprise et les vba sont bloqués lorsqu'ils sont dits étrangers.

J'essayerais depuis chez moi je pense. Merci pour votre aide.

D'ailleurs pourquoi on ne doit pas mettre de select dans le VBA ? Je n'ai vu que ca dès que j'ai commencé...

Bonjour

D'ailleurs pourquoi on ne doit pas mettre de select dans le VBA ?

Les Select et Selection ralentissent le code. Ils ne sont à utiliser que dans de rare cas. Exemple, si vous voulez sélectionner une feuille après une exécution de code.
Sinon VBA fait très bien son travail sans ces instructions.
Plutot que d'utiliser ces instructions, il vous suffit de préciser où doit être effectué le code.

Exemple : Si vous devez ajouter un chiffre 1 en A1 de la feuille Toto, faite ceci

Sheets("TOTO").Range("A1")=1

Plutot que ceci

Sheets("TOTO").select
Range("A1")=1

Cordialement

oui c'est vrai que ca tombe de sens maintenant que vous le dites.

Merci pour l'astuce

Rechercher des sujets similaires à "vba mes copient pas"