Maccro ne s'exécute pas entièrement
Sonata ArcticaMembre habitué
- Messages
- 88
- Excel
- 2016
- Inscrit
- 06/03/2016
- Emploi
- Contrôleur de gestion, auditeur interne
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
m
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
Sonata ArcticaMembre habitué
- Messages
- 88
- Excel
- 2016
- Inscrit
- 06/03/2016
- Emploi
- Contrôleur de gestion, auditeur interne
super merci !