Erreur d'execution 1004 : impossible d'ajouter une reference source déjà existante

**lps02** · 26/05/2025, 22h12

Bonjour à tous
cela fait un petit moment que je ne suis pas revenu vers vous...
J'ai créé une macro envba excel 2016. J'utilise maintenant Excel 365. Ma macro permettait :
De choisir les plages U8 à AP 16 de feuilles Excel que je choisis à partir d'une liste (usf des feuilles du classeur).
Et de faire la concatenation des valeur en gardant la premiere ligne et la colonne de gauche. depuis quelques temps, cette macro ne fonctionne plus et me met le message 1004 noté en objet à la ligne suivante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  .Range("U8:AP16").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False

Pouvez vous m'aider?
Je vous joins le code ci dessous

Merci de votre aide
Bien cordialement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
Option Explicit
Dim MaListe() As Variant, nbarb As Long, varb As Long, nbp As Long, vp As Long, vbi As Long, pptaire As String
Dim proprio() As String, n As Long, l As Long, a As Long, b As Long, estim() As Variant, NomFeuille As String, ValBi As Long
 
Private Sub UserForm_Initialize()
    Dim s As Object
    For Each s In ActiveWorkbook.Sheets
        If s.Name <> "Parametres" And s.Name <> "Page" Then
            Me.LBChoix.AddItem s.Name
        End If
    Next s
    Me.LBChoix.ListIndex = -1
End Sub
 
Private Sub LBChoix_Change()
    Dim i As Long, Sh As Worksheet, n As Long
 
    ReDim MaListe(0)
    ReDim proprio(0)
    ReDim estim(0)
 
    With Me.LBChoix
        nbarb = 0
        varb = 0
        nbp = 0
        vp = 0
        vbi = 0
        ValBi = 0
        pptaire = ""
 
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ' Sélection plage de valeur
                MaListe(UBound(MaListe)) = fmChoixFeuille.LBChoix.List(i) & "!R8C21:R16C42"
                ReDim Preserve MaListe(UBound(MaListe) + 1)
                ' Sélection des proprio
                proprio(UBound(proprio)) = Sheets(fmChoixFeuille.LBChoix.List(i)).Range("Z2").Value
                ReDim Preserve proprio(UBound(proprio) + 1)
                ' Copie des estimations de chaque feuille
                estim(UBound(estim)) = Sheets(fmChoixFeuille.LBChoix.List(i)).Range("AQ25").Value
                ReDim Preserve estim(UBound(estim) + 1)
 
                With Sheets(fmChoixFeuille.LBChoix.List(i))
                    nbarb = nbarb + .Range("Y17").Value
                    varb = varb + .Range("AG17").Value
                    nbp = nbp + .Range("Y18").Value
                    vp = vp + .Range("AG18").Value
                    vbi = vbi + .Range("AM17").Value
                    ValBi = ValBi + .Range("AQ23").Value
                    pptaire = Trim(pptaire) & ";" & .Range("Z2").Value
                End With
            End If
        Next i
    End With
End Sub
 
Private Sub CmdValid_Click()
    Application.DisplayAlerts = False
 
    If UBound(MaListe) > 0 Then
        ReDim Preserve MaListe(UBound(MaListe) - 1)
    End If
    If UBound(proprio) > 0 Then
        ReDim Preserve proprio(UBound(proprio) - 1)
    End If
    If UBound(estim) > 0 Then
        ReDim Preserve estim(UBound(estim) - 1)
    End If
 
    If ActiveWorkbook.ActiveSheet.Name = "Page" Then
        MsgBox "Attention! Il faut d'abord sélectionner" & Chr(10) & "la feuille que l'on veut copier!", vbExclamation + vbOKOnly, "Sélection de la Feuille :"
    Else
        ActiveWorkbook.ActiveSheet.Copy Before:=Sheets("Page")
        ActiveWorkbook.ActiveSheet.Name = "RECAPITULATIF"
        With Sheets("RECAPITULATIF")
            .Range("U8:AP16").ClearContents
            .Range("B1:Q216").ClearContents
            ' Consolidation des données
            .Range("U8:AP16").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
            ' Consolidation de la valeur du Bois d'industrie
            .Range("AQ23").Value = ValBi
            ' On colle les proprio
            For n = 0 To UBound(proprio)
                l = 30 + n
                .Range("AN" & l).Value = proprio(n)
            Next n
            ' On colle les estimations de chaque proprio
            For b = 0 To UBound(estim)
                l = 30 + b
                .Range("AQ" & l).Value = estim(b)
            Next b
            ' Calcul du pourcentage de chacun
            a = 30
            While .Range("AQ" & a).Value <> ""
                .Range("AR" & a).Value = .Range("AQ" & a).Value / .Range("AQ25").Value
                a = a + 1
            Wend
            ' Calcul nb et vol de chaque catégorie (arbre, perche et bi)
            .Range("Y17").Value = nbarb
            .Range("AG17").Value = varb
            .Range("Y18").Value = nbp
            .Range("AG18").Value = vp
            .Range("AM17").Value = vbi
            .Range("Z2").Value = Right(Trim(pptaire), Len(Trim(pptaire)) - 1)
        End With
 
        NomFeuille = InputBox("Nom du récapitulatif : ", "Nommer le Récap")
        Sheets("RECAPITULATIF").Name = "RECAP " & NomFeuille
    End If
    Application.DisplayAlerts = True
 
    Unload Me
End Sub
 
Private Sub CmdQuit_Click()
    Unload Me
End Sub

**Nain porte koi** · 27/05/2025, 00h16

Hello,

toujours difficile sans le fichier...
Je serais tenté de dire que la feuille "RECAPITULATIF" contient déjà une des références et que Excel ne veut pas de doublons.
Voyez ce qu'il y a dans l'onglet Données, Consolider et ou via VBA dans "MaListe()"

**lps02** · 27/05/2025, 08h17

Bonjour
Merci pour l'interet porte à ce sujet
Je comprends et je joins le fichier excel
Pour activer la macro, il faut aller dans le ruban cubage bois et appuyer sur bouton faire recapitulatif
Merci encoreCubageTest_05-2025.xlsm

**Nain porte koi** · 27/05/2025, 10h38

Re,

je confirme que sans le fichier il aurait été impossible de voir le "détail" qui tue

remplacez la ligne (34 de votre exemple)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

                MaListe(UBound(MaListe)) = fmChoixFeuille.LBChoix.List(i) & "!R8C21:R16C42"

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

                MaListe(UBound(MaListe)) = "'" & fmChoixFeuille.LBChoix.List(i) & "'!R8C21:R16C42"

En fait il faut ajouter des apostrophes (') autour des noms des feuilles. Je suppose que c'est du au passage de 365, 2016 devait être plus "permissif".

**lps02** · 27/05/2025, 19h50

Chapeau L'artiste
Un grand merci... Oui je suppose que cela vient de là... J'espère qu'il n'y aura pas trop de ce genre de changement dans mes autres programmes... ON s'adaptera
Grand merci encore

Erreur d'execution 1004 : impossible d'ajouter une reference source déjà existante [Toutes versions]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager