Erreur d'exécution 1004

Bonjour,

Je vous sollicite de nouveau votre aide pour un problème concernant un erreur d’exécution qui s'affiche a chaque fois que mon programme s’exécute. J'ai le code suivant:

Option Explicit

Sub CopPrincipale()
Dim Chemin As String, Fichier As String
Dim NbLg As Long
Dim tablo, dico, i, j, k, t, ln, v(), fdep, f
tablo = Range(Cells(1, 1), Cells(Range("A" & Rows.Count).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
    Set dico = CreateObject("Scripting.Dictionary")

    Set fdep = ActiveSheet
    Sheets.Add
    Set f = ActiveSheet
    fdep.Select
For i = 2 To UBound(tablo, 1)
        dico(tablo(i, 1)) = ""
    Next i

    k = dico.keys
    For i = 0 To dico.Count - 1
        'MsgBox k(i)
        ln = 0
        For t = 2 To UBound(tablo, 1)
            If k(i) = tablo(t, 1) Then
                ReDim Preserve v(UBound(tablo, 2), ln + 1)
                For j = 1 To UBound(tablo, 2)
                    v(j - 1, ln) = tablo(t, j)
                Next j
                ln = ln + 1
            End If
        Next t
  Application.ScreenUpdating = False
  Sheets("Principale").Copy
  With ActiveWorkbook
    With .Sheets(1)
      NbLg = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A1:v" & NbLg).Copy
      .Range("A1").PasteSpecial Paste:=xlPasteValues
      .Range("D1:v" & NbLg).Copy
     ' .Range("D1").PasteSpecial Paste:=xlPasteValues
      '.Range("A1:B" & NbLg).Copy
      '.Range("A1").PasteSpecial Paste:=xlPasteValues
      .Range("A1").Select
    End With
  End With
          With ActiveWorkbook
            .SaveAs ThisWorkbook.Path & "\" & " " & k(i)
            .Close
        End With
    Next i

    'f.Cells.Clear
    f.Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
End Sub
  MsgBox "Travail terminé."
End Sub
Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Feuil7").Select
    ActiveWindow.SelectedSheets.Delete
End Sub

Le code a pour but de créer des classeurs a partir de feuille 1 et il nome le classeur par le contenu des cellules A1, A2, A3... après la création des classeurs la feuille 2 nommée principale doit être copiée dans le nouveaux classeur crée en gardant la même mise en forme.

Vous trouviez ci jointe le classeur avec le code VBA

Merci en avance !

Bonjour,

Une proposition à étudier.

ALT F8 : Exécuter la peocédure.

Cdlt.

Public Sub CreateWorkbooks()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim sPath As String, sFile As String
Dim Cell As Range, rng As Range

    Set wb = ThisWorkbook
    sPath = wb.Path & Application.PathSeparator

    Set ws = wb.Worksheets("Classeur Créer")
    Set ws2 = wb.Worksheets("Principale")

    If ws.ListObjects(1).DataBodyRange Is Nothing Then Exit Sub

    For Each Cell In ws.ListObjects(1).DataBodyRange
        sFile = Cell.Text
        ws2.Copy
        With ActiveWorkbook
            With .Worksheets(1)
                On Error Resume Next
                Set rng = .UsedRange.SpecialCells(-4123)
                On Error GoTo 0
                If Not rng Is Nothing Then
                    rng.Value = rng.Value
                End If
                On Error Resume Next
                Set rng = .UsedRange.SpecialCells(-4174)
                On Error GoTo 0
                If Not rng Is Nothing Then
                    rng.Validation.Delete
                End If
            End With
            .SaveAs Filename:=sPath & sFile, FileFormat:=51
            .Close savechanges:=False
        End With
    Next Cell

End Sub

Option Explicit

Sub Selecion_données()

Dim wk As Workbook
Dim wk_selection As Worksheet
Dim wk_donnée As Worksheet

Dim i As Integer
Dim ligne As Integer
Dim DernLigne As Integer

Dim Rating As String
Dim Secteur As String
Dim Geographie As String

Set wk = ThisWorkbook
wk.Activate

Set wk_selection = Sheets("Selection")
Set wk_donnée = Sheets("Données Brutes")
DernLigne = wk_donnée.Cells(Rows.Count, 1).End(xlUp).Row

Rating = wk_donnée.Cells(ligne, 9).Value 'erreur défini par l'objet ou l'application'
Secteur = wk_donnée.Cells(ligne, 3).Value
Geographie = wk_donnée.Cells(ligne, 4).Value

Quelqu'un peut m'expliquer pour faire une erreur de type 1004 "défini par l'application ou par l'objet"

Bonjour,

C'est bien définir une variable ligne mais faut-il encore lui affecter une valeur.

Cdlt.

Hello Jean Eric, Je n'ai mis ici qu'une petite partie de mon code. Deja car il n'est pas fini, mais surtout car l'erreur 1004 intervient avant que ligne n'apparraisse, c'est au niveau de "rating" je l'ai mis en commentaire.

Ah je pense que j'ai compris ce que tu voulais dire !! Dans la ligne qui définit le rating, je le définis en fonction de "ligne". Or a ce niveau de la macro je ne lui ai pas encore dit qui était "ligne". Alors que moi je voulais juste lui donner toutes les infos au début pour ensuite être pépère pour coder... C'est parfois si idiot, ou alors je suis un idiot de ne pas penser comme un ordi ^^

Re,

A la lecture de ton code, ligne à la valeur 0 (par défaut).

Trouve moi la cellule Cells(0,9) dans la feuille de calcul.

Cdlt.