Salut WM,
Salut Chris,
bon, ce n'est pas aussi tendance que PowerQuery mais ça fait le job...
Un double-clic sur la feuille démarre la macro et met les fichiers à jour à volonté en fonction des nouveaux ajouts à la BDD.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim sWBK As Workbook, iRow%, iIdx%, sPath$, sFile$
'
Cancel = True
Application.ScreenUpdating = False
'
Range("A1").CurrentRegion.Sort key1:=Range("C2"), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).Copy Destination:=Range("AAA1")
Range("AAA1:AAA" & Range("AAA" & Rows.Count).End(xlUp).Row).RemoveDuplicates (1), xlNo
'
'Création des fichiers et ouverture
For x = 1 To 2
sPath = ThisWorkbook.Path
sFile = Choose(x, "Villes-20.xlsx", "Villes-200.xlsx")
If Len(Dir(sPath & "\" & sFile)) = 0 Then
Set sWBK = Workbooks.Add
sWBK.Sheets(1).Name = Split(sFile, "-")(0)
With sWBK.Sheets(1).[A1]
.Borders.LineStyle = xlContinuous
.Interior.Color = RGB(255, 190, 0)
.Value = Choose(x, "Villes comptant de 20 à 199 employés", "Villes comptant plus de 200 employés")
End With
sWBK.Sheets(1).Columns(1).AutoFit
sWBK.SaveAs Filename:=sFile
Else
Workbooks.Open (sPath & "\" & sFile)
End If
Set sWBK = Nothing
Next
'Inscription des villes si inexistantes et tri
For x = 1 To Range("AAA" & Rows.Count).End(xlUp).Row
iIdx = WorksheetFunction.CountIf(Columns(3), Range("AAA" & x).Value)
If iIdx >= 20 Then
Set sWBK = Workbooks(IIf(iIdx >= 20 And iIdx < 200, "Villes-20.xlsx", "Villes-200.xlsx"))
With sWBK.Sheets(1)
If WorksheetFunction.CountIf(.Columns(1), Range("AAA" & x).Value) = 0 Then _
iRow = .Range("A" & Rows.Count).End(xlUp).Row + 1: _
.Range("A" & iRow).Value = Range("AAA" & x).Value: _
If iRow > 2 Then .Columns(1).Sort key1:=.Range("A2"), order1:=xlAscending, Orientation:=xlByRows, Header:=xlYes
End With
sWBK.Save
Set sWBK = Nothing
End If
Next
Columns("AAA").ClearContents
'
Application.ScreenUpdating = True
'
End Sub
A+