VBA - Sélectionner les feuilles par un chiffre

Question

J'ai le code suivant qui m'affiche une erreur 1004. Je ne comprend pas l'erreur. Le code permet de sélectionner d'abord la feuille (avec un chiffre qui est associé à l'ordre) puis dans cette feuille sélectionné des cases ( code = Sheets(i).range...) Le code n'est surement pas parfais je viens de commencer mais le soucis n'est pas là...enfin j'espère. Merci Sub Actualiser() ' 'Trouve le nombre de feuilles dans le fichier Dim NbFeuil As Long, Sh As Worksheet NbFeuil = Sheets.Count 'VARIABLES Dim a As Integer a = 6 Dim p As Integer Dim i As Long For i = 1 To NbFeuil Sheets(i).Select 'selectionne les feuilles du classeur une par une If Sheets(i).Range("A4").Value = "Dimensions extérieures" Then Sheets(i).Range("C3").Copy 'Désignation du produit Sheets("Récapitulatif chiffrage").Cells(a, 1).PasteSpecial xlPasteValues Sheets(i).Range("J4").Copy 'Quantit Sheets("Récapitulatif chiffrage").Cells(a, 2).PasteSpecial xlPasteValues Sheets(i).Range("F5").Copy 'Longueur Sheets("Récapitulatif chiffrage").Cells(a, 3).PasteSpecial xlPasteValues Sheets(i).Range("G5").Copy 'Hauteur Sheets("Récapitulatif chiffrage").Cells(a, 4).PasteSpecial xlPasteValues Sheets(i).Range("H5").Copy 'Epaisseur Sheets("Récapitulatif chiffrage").Cells(a, 5).PasteSpecial xlPasteValues Sheets(i).Range("O4").Copy 'Surface unitaire Sheets("Récapitulatif chiffrage").Cells(a, 6).PasteSpecial xlPasteValues Sheets(i).Range("P4").Copy 'Surface TOTAL Sheets("Récapitulatif chiffrage").Cells(a, 7).PasteSpecial xlPasteValues Sheets(i).Range("R4").Copy 'Poids unitaire Sheets("Récapitulatif chiffrage").Cells(a, 8).PasteSpecial xlPasteValues Sheets(i).Range("S4").Copy 'Poids TOTAL Sheets("Récapitulatif chiffrage").Cells(a, 9).PasteSpecial xlPasteValues Sheets(i).Range("C1").Copy 'Nom de l'affaire Sheets("Récapitulatif chiffrage").Cells(2, 3).PasteSpecial xlPasteValuesAndNumberFormats Sheets(i).Range("C2").Copy 'Numéro du dossier Sheets("Récapitulatif chiffrage").Cells(2, 7).PasteSpecial xlPasteValuesAndNumberFormats a = a + 1 End If 'LIGNE DE TOTAL (idéalement mise après le NEXT i mais ne fonctionne pas après???) Sheets("Récapitulatif chiffrage").Select Cells(a, 2).Value = "TOTAUX" Cells(a, 3).Value = 0 Cells(a, 8).Value = 0 Cells(a, 10).Value = 0 Cells(a, 4).Value = "-" Cells(a, 5).Value = "-" Cells(a, 6).Value = "-" Cells(a, 7).Value = "-" Cells(a, 9).Value = "-" For p = 8 To (a - 1) Cells(a, 3).Value = Cells(a, 3).Value + Cells(p, 3).Value Cells(a, 8).Value = Cells(a, 8).Value + Cells(p, 8).Value Cells(a, 10).Value = Cells(a, 10).Value + Cells(p, 10).Value Next p Next i End Sub...

Jean-Eric · Accepted Answer

Bonjour,
Une proposition !?
Cdlt.

Option Explicit

Sub Actualiser()
Dim Sh As Worksheet, sh2 As Worksheet
Dim NbFeuil As Long, a As Long, p As Long, i As Long

    NbFeuil = Sheets.Count
    Set sh2 = Worksheets("Récapitulatif chiffrage")
    a = 6

    For i = 1 To NbFeuil
        Set Sh = Worksheets(i)
        If Sh.Cells(4, 1).Value = "Dimensions extérieures" Then
            'Désignation du produit
            sh2.Cells(a, 1).Value = Sh.Cells(3, 3).Value
            'Quantite
            sh2.Cells(a, 2).Value = Sh.Cells(4, 10).Value
            'Longueur
            sh2.Cells(a, 3).Value = Sh.Cells(5, 6).Value
            'Hauteur
            sh2.Cells(a, 4).Value = Sh.Cells(5, 7).Value
            'Epaisseur
            sh2.Cells(a, 5).Value = Sh.Cells(5, 8).Value
            'Surface unitaire
            sh2.Cells(a, 6).Value = Sh.Cells(4, 15).Value
            'Surface TOTAL
            sh2.Cells(a, 7).Value = Sh.Cells(4, 16).Value
            'Poids unitaire
            sh2.Cells(a, 8).Value = Sh.Cells(4, 17).Value
            'Poids TOTAL
            sh2.Cells(a, 9).Value = Sh.Cells(4, 18).Value
            'Nom de l'affaire
            sh2.Cells(2, 3).Value = Sh.Cells(1, 3).Value
            'Numéro du dossier
            sh2.Cells(2, 7).Value = Sh.Cells(2, 3).Value
            a = a + 1
        End If
    Next i

    With sh2
        .Cells(a, 2).Value = "TOTAUX"
        .Cells(a, 3).Value = 0
        .Cells(a, 8).Value = 0
        .Cells(a, 10).Value = 0
        .Cells(a, 4).Value = "-"
        .Cells(a, 5).Value = "-"
        .Cells(a, 6).Value = "-"
        .Cells(a, 7).Value = "-"
        .Cells(a, 9).Value = "-"
        For p = 8 To (a - 1)
            .Cells(a, 3).Value = .Cells(a, 3).Value + .Cells(p, 3).Value
            .Cells(a, 8).Value = .Cells(a, 8).Value + .Cells(p, 8).Value
            .Cells(a, 10).Value = .Cells(a, 10).Value + .Cells(p, 10).Value
        Next p
    End With

End Sub

Dan · Answer

Je ne vais pas vous répondre puisque Jean Eric vous donne une solution mais il me semblait avoir déjà vu ce genre de code. Je vous avais déjà écrit d'éviter les Select dans les codes...--&gt; https://forum.excel-pratique.com/s/goto/1019147 Apparemment cela n'a servi à rien Cordialement...