Bonjour,
Je vous donne mon code afin qu'une bonne ame puise me venir en aide car ma macro s'arrête après qu'il est rencontré un 2eme fichier manquant
Sub Récupération_n°_bordereaux()
Dim repert As String
Dim fich As String
Dim feuil As String
Dim feuil2 As String
Application.DisplayAlerts = False
On Error GoTo err
Sheets("Récap").Select
Range("A2").Select
Do While ActiveCell.Offset.Value <> ""
repert = ActiveCell.Offset(0, 1).Value
fich = ActiveCell.Offset(0, 2).Value
feuil = ActiveCell.Offset(0, 3).Value
feuil2 = ActiveCell.Offset(0, 4).Value
ligne = ActiveCell.Row
ChDir (repert)
Workbooks.Open Filename:= _
(repert & "\" & fich)
Sheets(feuil).Select
ActiveWindow.SmallScroll Down:=-48
numden = Range("B5").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 5).Value = numden
Windows(fich).Activate
Sheets(feuil2).Select
ActiveWindow.SmallScroll Down:=-48
numden2 = Range("G6").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 6).Value = numden2
Windows(fich).Activate
numden3 = Range("K6").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 7).Value = numden3
Windows(fich).Activate
ActiveWorkbook.Saved = True
ActiveWindow.Close
GoTo Suite
err:
Select Case err.Number
Case 54: Range("F" & ligne).Value = "Fichier introuvable"
Case 76: MsgBox "Chemin incorrect"
Case Else: Range("F" & ligne).Value = "Fichier introuvable"
End Select
GoTo Suite
Suite:
ActiveCell.Offset(1, 0).Select
Loop
Application.DisplayAlerts = True
End Sub
Merci d'avance de votre aide
Mikael
Je vous donne mon code afin qu'une bonne ame puise me venir en aide car ma macro s'arrête après qu'il est rencontré un 2eme fichier manquant
Sub Récupération_n°_bordereaux()
Dim repert As String
Dim fich As String
Dim feuil As String
Dim feuil2 As String
Application.DisplayAlerts = False
On Error GoTo err
Sheets("Récap").Select
Range("A2").Select
Do While ActiveCell.Offset.Value <> ""
repert = ActiveCell.Offset(0, 1).Value
fich = ActiveCell.Offset(0, 2).Value
feuil = ActiveCell.Offset(0, 3).Value
feuil2 = ActiveCell.Offset(0, 4).Value
ligne = ActiveCell.Row
ChDir (repert)
Workbooks.Open Filename:= _
(repert & "\" & fich)
Sheets(feuil).Select
ActiveWindow.SmallScroll Down:=-48
numden = Range("B5").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 5).Value = numden
Windows(fich).Activate
Sheets(feuil2).Select
ActiveWindow.SmallScroll Down:=-48
numden2 = Range("G6").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 6).Value = numden2
Windows(fich).Activate
numden3 = Range("K6").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 7).Value = numden3
Windows(fich).Activate
ActiveWorkbook.Saved = True
ActiveWindow.Close
GoTo Suite
err:
Select Case err.Number
Case 54: Range("F" & ligne).Value = "Fichier introuvable"
Case 76: MsgBox "Chemin incorrect"
Case Else: Range("F" & ligne).Value = "Fichier introuvable"
End Select
GoTo Suite
Suite:
ActiveCell.Offset(1, 0).Select
Loop
Application.DisplayAlerts = True
End Sub
Merci d'avance de votre aide
Mikael