Erreur execution 1004
Drakov666
-
titi 22 -
titi 22 -
Bonjour
j'ai une macro prenant dans un fichier diverses données mais lorsque je la lance la macro stoppe et me met ce message : Erreur d'execution 1004 et surlignant ceci
: Sheets("tableau").Cells(ligne, 3) = adrdesta2
voici tout le reste du code
Sub CSuppEntetePusatyp()
' ajout de la feuille tableau
Sheets.Add
Sheets("feuil1").Select
Sheets("feuil1").Name = ("tableau")
'nombre de pro
Dim nom
Dim adr1
Dim codepost
Dim ville
Dim ligne
nom = "["
ligne = 1
For rang = 1 To 10000
ranga = Sheets("p_usatyp").Cells(rang, 1)
nomdest = InStr(ranga, nom)
If nomdest = "1" Then nomdesta = Sheets("p_usatyp").Cells(rang, 1): Sheets("tableau").Cells(ligne, 1) = nomdesta: adrdesta = Sheets("p_usatyp").Cells(rang + 2, 1): Sheets("tableau").Cells(ligne, 2) = adrdesta: adrdesta1 = Sheets("p_usatyp").Cells(rang + 3, 1): Sheets("tableau").Cells(ligne, 4) = adrdesta1: adrdesta2 = Sheets("p_usatyp").Cells(rang + 4, 1): Sheets("tableau").Cells(ligne, 3) = adrdesta2: ligne = ligne + 1
Next
Sheets("tableau").Select
nombre = 0
For Each ran In Range("a1:a7000")
If ran <> "" Then nombre = nombre + 1 Else GoTo 100
Next
100 nombre = nombre + 1
'nom
ote = "[BUDL]"
For rang = 1 To nombre
nom = Cells(rang, 1)
budl = InStr(nom, ote)
budl = budl - 1
If budl > 0 Then nomdef = Left(nom, budl): nomdefa = Mid(nomdef, 8): Cells(rang, 1) = nomdefa
Next
'adresse
For rang = 1 To nombre
adra = Cells(rang, 2)
adrdef = Mid(adra, 18)
Cells(rang, 2) = adrdef
Next
'ville
For rang = 1 To nombre
ville = Cells(rang, 4)
villa = Mid(ville, 18)
Cells(rang, 4) = villa
Next
'entetes du tableau
Range("A1").Select
Selection.EntireRow.Insert
ActiveCell.FormulaR1C1 = "Nom"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Adresse"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Codep"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Ville"
Range("D2").Select
' tri alphabétique
Sheets("tableau").Select
Columns("A:j").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
merci
j'ai une macro prenant dans un fichier diverses données mais lorsque je la lance la macro stoppe et me met ce message : Erreur d'execution 1004 et surlignant ceci
: Sheets("tableau").Cells(ligne, 3) = adrdesta2
voici tout le reste du code
Sub CSuppEntetePusatyp()
' ajout de la feuille tableau
Sheets.Add
Sheets("feuil1").Select
Sheets("feuil1").Name = ("tableau")
'nombre de pro
Dim nom
Dim adr1
Dim codepost
Dim ville
Dim ligne
nom = "["
ligne = 1
For rang = 1 To 10000
ranga = Sheets("p_usatyp").Cells(rang, 1)
nomdest = InStr(ranga, nom)
If nomdest = "1" Then nomdesta = Sheets("p_usatyp").Cells(rang, 1): Sheets("tableau").Cells(ligne, 1) = nomdesta: adrdesta = Sheets("p_usatyp").Cells(rang + 2, 1): Sheets("tableau").Cells(ligne, 2) = adrdesta: adrdesta1 = Sheets("p_usatyp").Cells(rang + 3, 1): Sheets("tableau").Cells(ligne, 4) = adrdesta1: adrdesta2 = Sheets("p_usatyp").Cells(rang + 4, 1): Sheets("tableau").Cells(ligne, 3) = adrdesta2: ligne = ligne + 1
Next
Sheets("tableau").Select
nombre = 0
For Each ran In Range("a1:a7000")
If ran <> "" Then nombre = nombre + 1 Else GoTo 100
Next
100 nombre = nombre + 1
'nom
ote = "[BUDL]"
For rang = 1 To nombre
nom = Cells(rang, 1)
budl = InStr(nom, ote)
budl = budl - 1
If budl > 0 Then nomdef = Left(nom, budl): nomdefa = Mid(nomdef, 8): Cells(rang, 1) = nomdefa
Next
'adresse
For rang = 1 To nombre
adra = Cells(rang, 2)
adrdef = Mid(adra, 18)
Cells(rang, 2) = adrdef
Next
'ville
For rang = 1 To nombre
ville = Cells(rang, 4)
villa = Mid(ville, 18)
Cells(rang, 4) = villa
Next
'entetes du tableau
Range("A1").Select
Selection.EntireRow.Insert
ActiveCell.FormulaR1C1 = "Nom"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Adresse"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Codep"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Ville"
Range("D2").Select
' tri alphabétique
Sheets("tableau").Select
Columns("A:j").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
merci
A voir également:
- Erreur execution 1004
- Erreur t32 ✓ - Forum Livebox
- Erreur 3000 france tv - Forum Lecteurs et supports vidéo
- Erreur 0x80070643 - Accueil - Windows
- Corriger l'erreur 0x80070643 de la mise à jour KB5034441 de Windows 10 - Accueil - Windows
- Code erreur f3500-31 ✓ - Forum Bbox Bouygues