1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
Sub MAJ201()
'déclaration des variables
Dim Fichier, rep1, rep2 As String 'chemin du fichier
Dim shA, shB As Worksheet 'Feuille A
Dim wB, wA As Workbook 'Classeur
Dim lignevide, lignevide1, lignevide0, lignevidef1, lignevide2, lignevidef2, lignevide3, i, j, k, feuille As Integer 'compteur1
Fichier = ThisWorkbook.Sheets("listes").Range("A2").Value
On Error GoTo errorhandler
travail:
Application.DisplayAlerts = False 'désactive les boites de dialogue
Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
Set wB = Workbooks.Open(Filename:=Fichier) 'pointe le fichier que l'on va extraire
On Error GoTo erreurGénérale
Set shA = ThisWorkbook.Sheets("Data200")
Set shB = wB.Sheets("Data201")
'MAJ data
lignevide0 = shB.Range("A" & Rows.Count).End(xlUp).Row + 1 'donne le numero de la premiere ligne vide du wb
lignevide1 = shA.Range("A" & Rows.Count).End(xlUp).Row + 1
shB.Range("A4", "S" & lignevide0).Copy Destination:=shA.Range("a" & lignevide1)
lignevidef1 = shA.Range("A" & Rows.Count).End(xlUp).Row + 1
shA.Range("A4", "S" & lignevidef1).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 'supprime les doublons
For ligne = 4 To lignevidef1 Step 1
If IsEmpty(shA.Range("A" & ligne)) Then
shA.Rows(ligne & ":" & ligne).Delete
End If
Next ligne
shA.Columns.AutoFit 'ajuste les colonnes au texte
'MAJ rapport responsable
lignevide2 = wB.Sheets("Rapport responsable").Range("A" & Rows.Count).End(xlUp).Row + 1 'donne le numero de la premiere ligne vide du wb
lignevide3 = ThisWorkbook.Sheets("Items importants").Range("A" & Rows.Count).End(xlUp).Row + 1
wB.Sheets("Rapport responsable").Range("A5", "S" & lignevide2).Copy Destination:=ThisWorkbook.Sheets("Items importants").Range("a" & lignevide3)
lignevidef2 = ThisWorkbook.Sheets("Items importants").Range("A" & Rows.Count).End(xlUp).Row + 1
wB.Close False ' ferme sans sauve
ThisWorkbook.Sheets("Items importants").Range("A4", "A" & lignevidef2).CurrentRegion.RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 'supprime les doublons
ThisWorkbook.Sheets("Items importants").Columns.AutoFit 'ajuste les colonnes au texte
For ligne = 4 To lignevidef2 Step 1
If IsEmpty(shA.Range("A" & ligne)) Then
shA.Rows(ligne & ":" & ligne).Delete
End If
Next ligne
Application.DisplayAlerts = True 'réactive les boites de dialogue
Exit Sub
errorhandler:
If IsEmpty(Fichier) Then
Fichier = "Chemin d'acces vide"
End If
rep1 = MsgBox("Le fichier est introuvable, le chemin enregistré actuellement est :" & vbLf & vbLf & Fichier & vbLf & vbLf & "Voulez vous le modifier ?", vbYesNo + vbCritical, "Erreur chemin fichier à extraire (UAP202)")
If rep1 = vbYes Then
changementFichier:
Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*") 'Affiche la boîte de dialogue "Ouvrir" et ouvre le fichier selectionné
ThisWorkbook.Sheets("listes").Range("A2") = Fichier
GoTo travail
End If
If rep1 = vbNo Then
wB.Close False
Exit Sub
End If
erreurGénérale:
rep2 = MsgBox("Assurez vous de la bonne structure des fichier d'émission et de reception, si le problème persiste contactez l'administrateur." & vbLf & vbLf & "Voulez-vous changer l'emplacement du fichier ?", vbYesNo + vbCritical, "Erreur compilation (UAP201)")
If rep2 = vbYes Then
GoTo changementFichier
End If
If rep2 = vbNo Then
wB.Close False
End If
End Sub |
