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
|
Sub ExtraireDonneesExport()
Application.ScreenUpdating = False 'rend intouchable le classeur en court de travail
Dim ClasseurDest As Workbook
Dim ClasseurSource As Workbook
Dim FeuilLancement As Worksheet
Dim FeuilDestAno As Worksheet
Dim FeuilDestCT As Worksheet
Dim FeuilSourceAno As Worksheet
Dim FeuilSourceCT As Worksheet
Dim MaxColAno As Long, MaxLigAno As Long, MaxColCT As Long, MaxLigCT As Long
Set ClasseurDest = ActiveWorkbook
Set FeuilLancement = ActiveSheet
Dim nf
nf = Application.GetOpenFilename("Fichiers Xls,*.xls")
If nf = False Then
'MsgBox "Traitement abandonné"
Exit Sub
End If
's'il est déjà ouvert, le traitement plante
On Error GoTo Err_Test ' Gestion des erreurs
Workbooks.Open Filename:=nf
Set ClasseurSource = Workbooks(nf)
Set FeuilSourceAno = ClasseurSource.Worksheets("Résultat Ano>RQ")
Set FeuilSourceCT = ClasseurSource.Worksheets("Résultat CT>RQ")
Err_Test: ' Étiquette de branchement en cas d'erreur
' ou suite du traitement ordinaire.
If Err.Number = 1004 Then ' S'il y a une erreur (l'Objet Err contient les informations)...
MsgBox "Veuillez fermer le fichier Source et relancer le traitement" ' Mon message d'erreur,
Resume Next ' Reprend à la ligne suivante,
Exit Sub
End If
On Error GoTo 0
Range(FeuilSourceAno.[A1]).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
MaxColAno = Selection.Columns.Count 'il faut 18 colonnes => erreur à mettre en place si le contraire
MaxLigAno = Selection.Rows.Count
Range(FeuilDestAno.Cells(1, MaxLigAno), FeuilDestAno.[AA:9999]).Select
Selection.ClearContents
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
FeuilLancement.Cells(6, 2) = Now ' jour et heure de modification
FeuilLancement.Cells(7, 2) = Application.UserName ' Utilisateur
'MonRange.Find(What as Variant)
' => renvoi un range si trouve
' => Nothing sinon (erreur à gérer)
Application.ScreenUpdating = True 'permet la modification du classeur (interrompue au début du Sub)
End Sub |
Partager