Bonsoir,
Un conseil : il est préférable de renommer "Feuil1" par "Facture". Cela facilite la compréhension du programme, mais c'est aussi plus simple pour l'utilisateur.
Dans mes tests, j'ai conservé l'appellation " Feuil1", il faudra donc que tu changes la ligne
Set ShFacture = Wbk.Worksheets("Feuil1")
en mettant "Facture" si tu changes le nom de tes feuilles
Voici le code :
Option Explicit
Sub MajDeTousLesClasseurs()
Dim sFichier As String, sCheminFact As String, sCheminSave As String
Dim Wbk As Workbook, ShFacture As Worksheet
' Déclaration des variables répertoires
sCheminFact = "D:\Test\Factures\"
sCheminSave = "D:\Test\Factures\Save\"
sFichier = Dir(sCheminFact & "\*.xl*") ' Recherche du premier Fichier Excel du répertoire
Do While sFichier <> "" ' Boucle dans le répertoire
Workbooks.Open sCheminFact & sFichier ' Ouverture du classeur
Set Wbk = Workbooks(sFichier)
Set ShFacture = Wbk.Worksheets("Feuil1")
Call MajSynthese(ShFacture) ' Màj de la synthèse
Workbooks(sFichier).Close False ' Fermeture du classeur
Name (sCheminFact & sFichier) As (sCheminSave & sFichier) ' Déplacement du fichier dans le répertoire Save
sFichier = Dir ' Fichier suivant
Loop
' ThisWorkbook.Save ' Enlever l'apostrophe pour sauvegarde automatique
End Sub
Private Sub MajSynthese(ShFacture As Worksheet)
Dim lPremLig As Long, lLig As Long, lLigSynth As Long, ShSynth As Worksheet
Set ShSynth = ThisWorkbook.Worksheets("Synthèse")
With ShSynth
lPremLig = 6 ' Première ligne détail de la facture
For lLig = lPremLig To ShFacture.UsedRange.Rows.Count
If Len(ShFacture.Cells(lLig, "B")) > 3 Then ' on teste que la longueur du libellé article est >3C (un ctrl parmi d'autres)
lLigSynth = ShSynth.UsedRange.Rows.Count + IIf(.Cells(ShSynth.UsedRange.Rows.Count, "A") = Empty, 0, 1)
.Cells(lLigSynth, "A") = ShFacture.Parent.Name ' Nom du classeur
.Cells(lLigSynth, "B") = ShFacture.Range("B2").Value ' Code Facture (Entete)
.Cells(lLigSynth, "C") = ShFacture.Cells(lLig, "A").Value ' Date (Ligne)
.Cells(lLigSynth, "D") = Replace(ShFacture.Range("D3").Value, vbLf, " - ") ' Adresse (Entete)
.Cells(lLigSynth, "E") = ShFacture.Cells(lLig, "B").Value ' libellé article (Ligne)
.Cells(lLigSynth, "F") = ShFacture.Cells(lLig, "C").Value ' PU (Ligne)
.Cells(lLigSynth, "G") = ShFacture.Cells(lLig, "D").Value ' Qté (Ligne)
.Cells(lLigSynth, "H") = ShFacture.Cells(lLig, "E").Value ' Total (Ligne)
End If
Next lLig
End With
End Sub
Je te mets le fichier de synthèse en pj
Tu dois changer les deux lignes :
sCheminFact = "D:\Test\Factures\"
sCheminSave = "D:\Test\Factures\Save\"
en mettant les chemins des répertoires des factures et des sauvegardes (Save)
Tu testes cela et me redis les ajustements à faire.
A+
Benead