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
| Sub Implémenter_data_BDD_dans_fichier_de_travail()
Dim wbk As Workbook
Dim Sh As Worksheet, aSh As Worksheet
Dim Fichier As Variant
Dim Kol As New Collection
Dim LastLig1 As Long, LastLig2 As Long, i As Long, Nb As Long, vRow As Long
Dim c As Range
Application.ScreenUpdating = False
Set aSh = ThisWorkbook.Sheets("BDD")
Fichier = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If Fichier <> False Then
Set wbk = Workbooks.Open(Fichier)
Set Sh = wbk.Sheets("MDL") 'Ou Set Sh = wbk.Sheets("NomFeuilleACompléter") sinon mettre wbk.Sheets(2) par exemple
With aSh
.AutoFilterMode = False 'enlève filtre auto de la BDD
LastLig1 = .Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne de la BDD
End With
With Sh
.AutoFilterMode = False 'enlever filtre auto de la feuille de travail
LastLig2 = .Cells(Rows.Count, 2).End(xlUp).Row 'dernière ligne de la feuille de travail
For i = 2 To LastLig2S 'S ?????? pourquoi S ? faire tourner un i de la deuxième à la dernière ligne de la feuille de travail
On Error Resume Next
Kol.Add .Range("B" & i).Value, .Range("B" & i).Value 'on crée une collection des id en colonne B
On Error GoTo 0 'si erreur rien faire
Next i
For i = 1 To Kol.Count 'on commence au 1er id de la collection
vRow = .Range("B1:B" & LastLig2).Find(Kol(i), LookIn:=xlValues, Lookat:=xlWhole).Row '???? retenir le numéro de ligne ou on est
Set c = aSh.Range("A1:A" & LastLig1).Find(Kol(i), LookIn:=xlValues, Lookat:=xlWhole) 'on cherche si ça existe dans BDD
If Not c Is Nothing Then 'si il trouve dans BDD
aSh.Range("A1:A" & LastLig1).AutoFilter Field:=1, Criteria1:=Kol(i) 'on filtre BDD sur ce critère
Nb = aSh.Range("A1:A" & LastLig1).SpecialCells(xlCellTypeVisible).Count - 1 'on compte le nombre de lignes concernées (moins la ligne titre)
.Rows(vRow & ":" & vRow + Nb - 1).Insert 'on isere toutes ces lignes une case au dessus de là ou on est
LastLig2 = LastLig2 + Nb 'la dernière ligne remplie de la feuille de travail se décale vers le bas du nombre de lignes insérées
aSh.Range("A2:L" & LastLig1).SpecialCells(xlCellTypeVisible).Copy .Range("B" & vRow) 'on copie dedans le contenu de la BDD filtrée sur le critère
.Range("B" & vRow & ":M" & vRow + Nb - 1).Font.ColorIndex = 14 'on colorie les lignes insérées en vert
Set c = Nothing
aSh.AutoFilterMode = False 'on enlève le filtre de BDD
Else
'.Range("B" & vRow & ":M" & vRow).Font.ColorIndex = 3
.Range("B" & vRow).Font.ColorIndex = 3 'on colorie l'id en rouge
End If
Next i
End With
wbk.Save 'sauver feuille de travail
'wbk.Close
Set Sh = Nothing
Set wbk = Nothing
End If
Set aSh = Nothing
End Sub |
Partager