Erreur boucle

Bonjour forum,

je cherche à extraire des données d'un devis dans lequel B8 est le nom du devis et G49 est le total du devis

comme tous mes devis sont séparés je cherche à les compiler dans un autre classeur histoire de me donner un total.

Seul hic, le code me renvoi seulement les valeurs du derniers fichiers dans le dossier ... ai-je raté quelque chose?

Sub BatchTotalContrat()
   Dim MyFolder As String 
   Dim MyFile As String 

   Dim wbk As Workbook 

   Dim LastRow As Long, ws As Worksheet
Dim LastRow2 As Long

    'Set ws = Sheets("Clients")

    LastRow = Workbooks("GestionFactureBD.xlsm").Sheets("Clients").Range("DF" & Rows.Count).End(xlUp).Row + 1
    LastRow2 = Workbooks("GestionFactureBD.xlsm").Sheets("Clients").Range("DG" & Rows.Count).End(xlUp).Row + 1

On Error Resume Next

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "Choisir un dossier"

.Show

.AllowMultiSelect = False

   If .SelectedItems.Count = 0 Then 

MsgBox "Aucun dossier choisi"

      Exit Sub

   End If

MyFolder = .SelectedItems(1) & "\" 

End With

MyFile = Dir(MyFolder) 

'Boucle

Do While MyFile <> ""

Application.DisplayAlerts = False
   Set wbk = Workbooks.Open(fileName:=MyFolder & MyFile)

   Workbooks("GestionFactureBD.xlsm").Sheets("Clients").Range("df" & LastRow) = wbk.Sheets(1).Range("b8").Value
Workbooks("GestionFactureBD.xlsm").Sheets("Clients").Range("dg" & LastRow2) = wbk.Sheets(1).Range("g49").Value

wbk.Close savechanges:=False

MyFile = Dir 'DIR donne le fichier suivant non?

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

bump

Bonjour,

tes recherches de la dernière ligne doivent être déplacées dans la boucle while

Évidemment

merci d'avoir fait la lumière!

Rechercher des sujets similaires à "erreur boucle"