Erreur d'exécution 1004 à répétition

Salutation

J'ai un problème avec un code de remplissage d'une feuille de calcul (test1, test2) mais cela échoue car la méthode Activate du Worksheet aurait échoué. Ainsi il me faut redémarrer Visual Basic pour pouvoir le lancer et là seul la page test est remplit , je ne sais pas quoi faire.

Voici la ligne mis en sur brillance est ci dessous

Sheets("test1").Activate

et voici le code:

Sub remplissage1()
Dim finp As Double
Dim nb As Long, i As Double, j As Long, Finl As Long
Dim nb2 As Long, i2 As Double, j2 As Long, Finl2 As Long, Finp2 As Long
Dim X As Boolean
Dim y As Integer
nb2 = 1 'Conteur Data
j = 1 'conteur de colone
i = 1 'conteur de ligne
finp = 334        ' profondeur/ligne
Finl = 43      'longueur/colonne

Sheets("test1").Activate
Sheets("test1").Select 'Feuille Selectionné

Do While i <= finp

    For j = 1 To Finl Step 1
    X = False: On Error Resume Next 'conteur de choix multiple
    X = Cells(i, j).Validation.InCellDropdown 'conteur de choix multiple
    y = IIf(X = True, 11111, 0) 'conteur de choix multiple
    'Debut de la selection

        Sheets("test1").Cells(i, j).Select

            If Not y = 11111 And Not Left(Cells(i, j).Formula, 1) = "=" And Not Cells(i, j).MergeCells And IsNumeric(Cells(i, j)) And Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous And Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Borders(xlEdgeTop).LineStyle = xlContinuous And Selection.Borders(xlEdgeRight).LineStyle = xlContinuous Then
                   Sheets("test").Cells(2, nb2) = Sheets("test1").Cells(i, j)
                   Sheets("test").Cells(3, nb2) = i
                   Sheets("test").Cells(4, nb2) = j
                   Sheets("test1").Cells(i, j) = Sheets("test").Cells(1, nb2)
                   nb2 = nb2 + 1
            End If

    Next

i = i + 1
Loop

Sheets("test2").Select 'Feuille Selectionné
j = 1 'conteur de colone
i = 1 'conteur de ligne
Do While i <= finp

    For j = 1 To Finl Step 1
    X = False: On Error Resume Next 'conteur de choix multiple
    X = Cells(i, j).Validation.InCellDropdown 'conteur de choix multiple
    y = IIf(X = True, 11111, 0) 'conteur de choix multiple
    'Debut de la selection

        Sheets("test1").Cells(i, j).Select

            If Not y = 11111 And Not Left(Cells(i, j).Formula, 1) = "=" And Not Cells(i, j).MergeCells And IsNumeric(Cells(i, j)) And Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous And Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Borders(xlEdgeTop).LineStyle = xlContinuous And Selection.Borders(xlEdgeRight).LineStyle = xlContinuous Then
                   Sheets("test").Cells(2, nb2) = Sheets("test2").Cells(i, j)
                   Sheets("test").Cells(3, nb2) = i
                   Sheets("test").Cells(4, nb2) = j
                   Sheets("test2").Cells(i, j) = Sheets("test").Cells(1, nb2)
                   nb2 = nb2 + 1
            End If

    Next

i = i + 1
Loop
'MsgBox i
'MsgBox j
'Cells(i, j).Select

End Sub

Bonjour,

Voici une proposition de réorganisation de votre code :

Sub remplissage1()
Dim n&, i&, j&, y&, X As Boolean, tws, ws as worksheet
tws = array("test1", "test2")

for each ws in worksheets(tws)
    with ws
        for i = 1 to 334 'edit X Cellus
            For j = 1 To 43
                X = False: On Error Resume Next 'conteur de choix multiple
                with .cells(i, j)
                    X = .Validation.InCellDropdown 'conteur de choix multiple
                    y = IIf(X = True, 11111, 0) 'conteur de choix multiple
                    If Not y = 11111 And Not Left(.Formula, 1) = "=" And Not .MergeCells And IsNumeric(.value) And .Borders(xlEdgeLeft).LineStyle = xlContinuous And .Borders(xlEdgeBottom).LineStyle = xlContinuous And .Borders(xlEdgeTop).LineStyle = xlContinuous And .Borders(xlEdgeRight).LineStyle = xlContinuous Then
                        n = n + 1
                        Sheets("test").Cells(2, n) = .value
                        Sheets("test").Cells(3, n) = i
                        Sheets("test").Cells(4, n) = j
                        .value = Sheets("test").Cells(1, n)
                    End If
                end with
            Next j
        next i
    end with
next ws

End Sub

L'erreur peut survenir pour différentes raisons. Déjà, voyez si elle persiste sans l'activer.

Cdlt,

Alors merci 3GB pour ton code il m'a bien aider vis à vis du remplissage des page mais j'ai encore le problème 1004 qui apparait et en plus je ne peux même plus accéder aux références de l'onglet outil.

Et sur quelle ligne a lieu l'erreur ? Car le code n'est plus vraiment le même.

Edit : Vous êtes sûr qu'il s'agit d'une erreur 1004 ? Pas une erreur 9 ?

La il s'agit d'un autre programme, plus simple, que j'ai créer pour générer des nombre allant de 1 à 9000 pour alimenter la page test.

Voici le code :

Sub remplissage_test()
'Auteur Docmarti 24/08/2014

Dim Rise As Double, debut As Double, fin As Double
Dim nb As Long, i As Double, j As Long, Fin1 As Long

 'Executing with Book1.xlsm active and Book2.xlsx open.
Dim wb As Workbook

Sheets("test").Activate
Sheets("test").Select

j = 1 'debut en profondeur
Fin1 = 1       'profondeur

debut = 9000 ' debut en longueur
finp = 20000       'longueur

Sheets("test").Cells(1, 1).Select

Do While j <= Fin1

    For i = debut To finp Step 1

       Cells(j, i) = i

    Next
j = j + 1
Loop
j = j - 1
Cells(i, j).Select
MsgBox i
MsgBox j
End Sub

La ligne surligné est celle ci

       Cells(j, i) = i

Bonjour LaventureEstivene, 3GB,

Je reprends une partie de ton code ci-dessous

finp = 20000       'longueur

Sheets("test").Cells(1, 1).Select

Do While j <= Fin1

    For i = debut To finp Step 1

       Cells(j, i) = i

    Next i

Plutôt que noter VBA Excel dans ta version Excel, inscris plutôt la version exacte.

Ainsi on pourra avoir une idée du nombre de colonnes que présente ta version.

Car dans ton code la variable i finit à 20000. Or dans ma version 365, je n'en ai que 16384.

Et je doute que tu en ais d'avantage...

Donc si Cells(j,i) = i est surligné... poses toi la question du nombre de colonnes dont tu disposes?

Re, Salut X Cellus ,

Et j'ajouterais que c'est le seconde fois que je propose un code et que vous n'en tenez absolument pas compte. Ca peut vite être compliqué pour résoudre les problèmes si vous ne testez pas les propositions des contributeurs...

Il faut savoir que vos 2 codes n'ont rien à voir et, si j'ai apporté des modifications, c'est notamment parce que la plupart de vos variables, les .select et la boucle while sont inutiles.

Cdlt,

Suite,

On peut supposer que si tu utilises ton dernier code posté pour alimenter la page test.

Pour après vouloir te servir du code de 3GB tu seras forcément bloqué.

Je penses aussi que l'éditeur t'auras corrigé sinon par toi même. Dans le code fourni rapidement par 3GB.

with ws
        for i to 334
            For j = 1 To 43

Décidément le i te pose souci.

Oui, j'ai oublié le = 1 dans le for, je vais corriger ce détail.

Dans le code précédent, pour rappel :

Sub remplissage_test()
'Auteur Docmarti 24/08/2014

Dim Rise As Double, debut As Double, fin As Double
Dim nb As Long, i As Double, j As Long, Fin1 As Long '<<< en partie inutile, mauvais types

 'Executing with Book1.xlsm active and Book2.xlsx open.
Dim wb As Workbook '<<<inutile

Sheets("test").Activate '<<<inutile
Sheets("test").Select '<<<inutile

j = 1 'debut en profondeur '<<<inutile car le do while est inutile
Fin1 = 1       'profondeur '<<<inutile car une boucle à une itération

debut = 9000 ' debut en longueur '<<<inutile, pas besoin de variable
finp = 20000       'longueur '<<<inutile, idem

Sheets("test").Cells(1, 1).Select '<<<inutile

Do While j <= Fin1 '<<<inutile, boucle à une seule itération

    For i = debut To finp Step 1 '<<<inutile de préciser le pas

       Cells(j, i) = i

    Next
j = j + 1
Loop
j = j - 1 '<<<inutile de décrémenter
Cells(i, j).Select '<<<inutile, et inversion
MsgBox i '<<<inutile car i vaut 20001
MsgBox j '<<<inutile car j vaut 1
End Sub

Il pourrait être abrégé ainsi :

sub remp()
for k = 9000 to 20000
    sheets("test").cells(1, k).value = k
next k
end sub

Et surtout, il ne s'agit pas du code de départ en fait !

Et d'ailleurs, sur le code de départ, je ne suis pas sûr que la condition soit idéale. C'est délicat de tester la mise en forme. Il y a peut-être une meilleure solution.

Sans parler du X = .value puis .value = X ... J'imagine qu'il y a un calcul mais il serait préférable de le réaliser dans le code au moyen d'une fonction, qui dépendrait donc de i et de j si j'ai bien compris.

Cdlt,

3GB, je te remercie pour tes codes et t'assure que je les ai pris en compte et testé avec succès mais l'objectif de ce forum est la résolution des bugs et crash successive de mes codes après plusieurs exécution. Mais je te remercie pour ton aide, je fais tous cela pour un stage avant lequel j'ignorais jusqu'à l'existence même de VBA, donc merci. Merci aussi à toi X Celllus, j'ai vérifié ma version 2016 de Excel et elle est bien limité à 16 mille colonne.

Quant à la mise en forme, j'ai choisi cette méthode pour la tester car c'est ce qui me paraissais le plus logique. Je ne vois pas de quel fonction tu parle mais si tu as des noms, je suis preneur.