Maccro ne s'exécute pas entièrement

Bonjour ,

je doit lancer cette maccro mais elle ne s’exécute pas entièrement, quand je fait pas à pas elle exécute jusqu'a "clear content " de la feuille 1-stock poudre stock systeme. Et après elle saute les autre étapes (ça ouvre pas le fichier dans gp poudre ect... )

des idées svp, elle est longue mais j'ai marqué ce que le code doit faire mais après je vois pas ou sont les erreurs

merci pour votre aide, l'entreprise par à la dérive sans ces résultats

Sub stock_poudre()

Dim date_fin As Date
Dim date_systeme As Date
date_systeme = Date
date_fin = "11/04/2019"
If date_systeme > date_fin Then GoTo line1000

'effacer les donnees de la feuille 1-stock poudre stock systeme"
Sheets("1-stock poudre stock systeme").Select
Range(Cells(1, 1), Cells(1048576, 2)).Select

    Selection.ClearContents

'Chargement des 2 premieres colonnes article secondaire et quantite
'ouverture du fichier
ChDir "N:\GP\poudre"
fichier_stock = Application.GetOpenFilename("fichier excel (*.csv), *.csv", , "Sélectionnez le fichier stock systeme (Article_)...")
adresse_fichier_3_fichier_expedition_courte = Split(fichier_stock, "\")(UBound(Split(fichier_stock, "\")))

Workbooks.OpenText Filename:=fichier_stock, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True

'Workbooks.Open fichier_stock

Range(Cells(1, 1), Cells(1048576, 2)).Select: Selection.Copy

'fermer le fichier
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

'coller les donnees
Range("A1").Select

MsgBox ("appuyer sur entrer pour continuer")

ActiveSheet.Paste: Range("A1").Select

'vider le presse papier
Application.CutCopyMode = False

'actualiser le tcd
ActiveWorkbook.RefreshAll

'nombre de ligne du tcd en colonne I
nbr_tcd = Worksheets("1-stock poudre stock systeme").Range("E1").End(xlDown).Row

'copier dans un tableau le contenu du tcd sans la ligne marque vide
Dim tableau_copier()
ReDim Preserve tableau_copier(1 To 2, 1 To nbr_tcd)
For i = 2 To nbr_tcd
    tableau_copier(1, i) = Cells(i, 5)
    tableau_copier(2, i) = Cells(i, 6)
Next i

'effacer le contenu des 2 premiere colonnes
Range(Cells(2, 1), Cells(1048576, 2)).Select
    Selection.ClearContents

'copier le tcd en colonne 1 et 2 sans la ligne vide
For i = 2 To UBound(tableau_copier, 2) - 1
    If tableau_copier(1, i) = "(vide)" Then
        GoTo line100
    End If
        Cells(i, 1) = tableau_copier(1, i)
        Cells(i, 2) = tableau_copier(2, i)
line100:
Next i

'trier les 2 premiers colonnes
Columns("A:B").Select
    'Range("A230").Activate
    ActiveWorkbook.Worksheets("1-stock poudre stock systeme").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1-stock poudre stock systeme").Sort.SortFields.Add _
        Key:=Range("A2:A1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1-stock poudre stock systeme").Sort
        .SetRange Range("A1:B1048576")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

line1000:
End Sub
    

Slt,

a tester

   
Sub stock_poudre()

Dim date_fin As Date
Dim date_systeme As Date
Dim wsh As Worksheet
Set wsh = ThisWorkbook.Worksheets("1-stock poudre stock systeme")
date_systeme = Date
date_fin = "11/04/2019"  ' !!!!!! il faut adapter cette date !!!!!!
If date_systeme > date_fin Then GoTo line1000

'effacer les donnees de la feuille 1-stock poudre stock systeme"
wsh.Select
Range(Cells(1, 1), Cells(1048576, 2)).Select

    Selection.ClearContents

'Chargement des 2 premieres colonnes article secondaire et quantite
'ouverture du fichier
ChDir "N:\GP\poudre"
fichier_stock = Application.GetOpenFilename("fichier excel (*.csv), *.csv", , "Sélectionnez le fichier stock systeme (Article_)...")
adresse_fichier_3_fichier_expedition_courte = Split(fichier_stock, "\")(UBound(Split(fichier_stock, "\")))

Workbooks.OpenText Filename:=fichier_stock, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True

'Workbooks.Open fichier_stock

Range(Cells(1, 1), Cells(1048576, 2)).Select: Selection.Copy

'fermer le fichier
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

'coller les donnees
Range("A1").Select

MsgBox ("appuyer sur entrer pour continuer")

ActiveSheet.Paste: Range("A1").Select

'vider le presse papier
Application.CutCopyMode = False

'actualiser le tcd
ActiveWorkbook.RefreshAll

'nombre de ligne du tcd en colonne I
nbr_tcd = Worksheets("1-stock poudre stock systeme").Range("E1").End(xlDown).Row

'copier dans un tableau le contenu du tcd sans la ligne marque vide
Dim tableau_copier()
ReDim Preserve tableau_copier(1 To 2, 1 To nbr_tcd)
For i = 2 To nbr_tcd
    tableau_copier(1, i) = Cells(i, 5)
    tableau_copier(2, i) = Cells(i, 6)
Next i

'effacer le contenu des 2 premiere colonnes
Range(Cells(2, 1), Cells(1048576, 2)).Select
    Selection.ClearContents

'copier le tcd en colonne 1 et 2 sans la ligne vide
For i = 2 To UBound(tableau_copier, 2) - 1
    If tableau_copier(1, i) = "(vide)" Then
        GoTo line100
    End If
        Cells(i, 1) = tableau_copier(1, i)
        Cells(i, 2) = tableau_copier(2, i)
line100:
Next i

'trier les 2 premiers colonnes
Columns("A:B").Select
    'Range("A230").Activate
    ActiveWorkbook.Worksheets("1-stock poudre stock systeme").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1-stock poudre stock systeme").Sort.SortFields.Add _
        Key:=Range("A2:A1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1-stock poudre stock systeme").Sort
        .SetRange Range("A1:B1048576")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

line1000:
End Sub
     

super merci !

Rechercher des sujets similaires à "maccro execute pas entierement"