Option Explicit
Public ChemoldFSM
Public ChemOBDMAP
Public ChemnewFSM
Public NomnewFSM
Public NomoldFSM
Public NomOBDMAP
Public oldFSM As Workbook
Public newFSM As Workbook
Public OBDMAP As Workbook
Sub CB_Start_Click()
Dim soldFSM As Worksheet
Dim snewFSM As Worksheet
Dim sOBDMAP As Worksheet
Dim BoEcran As Boolean, BoAlert As Boolean, BoBarre As Boolean, BoEvent As Boolean, BoSaut As Boolean
Dim iCalcul As Integer
Dim objet As String
Dim colonne As String
Dim valeur As String
Dim i As Integer
Dim j As Integer
Dim alreadyfound As Range
Dim celluletrouvee As Range
Dim colonnetrouvee As Range
Dim ligtrouv As Integer
Dim lig As Integer
Dim coltrouv As Integer
Dim col As Integer
Dim DernLigne As Integer
Dim DernCol As Integer
Dim l As Integer
Dim k As Integer
Dim m As Integer
Dim A As Integer
Dim debut As Date, temps As Date, fin As Date
debut = Time
Set soldFSM = Workbooks(NomoldFSM).Worksheets(3)
Set snewFSM = Workbooks(NomnewFSM).Worksheets(3)
Set sOBDMAP = Workbooks(NomOBDMAP).Worksheets(3)
' Conservation des configurations existantes :
BoEcran = Application.ScreenUpdating
BoAlert = Application.DisplayAlerts
BoBarre = Application.DisplayStatusBar
iCalcul = Application.Calculation
BoEvent = Application.EnableEvents
BoSaut = snewFSM.DisplayPageBreaks
' On force les configurations :
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
snewFSM.DisplayPageBreaks = False
i = sOBDMAP.Columns(3).Find("", , , , xlByColumns, xlNext).Row - 1 'Nb lignes début OBD MAP jusqu'à fin tableau
j = sOBDMAP.Cells(6, Cells.Columns.Count).End(xlToLeft).Column + 1 'Nb colonnes début OBD MAP jusqu'à fin tableau
DernLigne = snewFSM.Range("C" & Rows.Count).End(xlUp).Row
DernCol = snewFSM.Cells(2, Cells.Columns.Count).End(xlToLeft).Column 'Numéro dernière colonne FSM Geely
A = DernLigne + 1
' MsgBox "derniere ligne : " & DernLigne & " et A = " & A
' MsgBox "Tableau de " & i & " lignes et " & j & " colonnes."
For k = 6 To i 'Parcourir les lignes du tableau de l'OBD MAP
For l = 5 To j 'Parcourir les colonnes du tableau de l'OBD MAP
objet = sOBDMAP.Cells(k, l).Value 'nom de l'objet
' MsgBox "On cherche " & objet = sOBDMAP.Cells(k, l).Value
If Not IsError(Application.Match(monitor, snewFSM.Range("H3:H400"), 0)) Then
' MsgBox objet & " déjà présent et copié."
Else
' MsgBox objet & " à copier."
If Len(monitor) = 2 Then
Set celluletrouvee = soldFSM.Range("H3:H370").Find(objet, LookIn:=xlValues, LookAt:=xlWhole)
Else
Set celluletrouvee = soldFSM.Range("H3:H370").Find(objet, LookIn:=xlValues, LookAt:=xlPart) 'recherche du moniteur dans la FSM du projet BMW/Magna
End If
If celluletrouvee Is Nothing Then
' MsgBox objet & " non trouvé à la ligne " & k & ", colonne " & l & "."
Else
ligtrouv = celluletrouvee.Row 'ligne de l'objet dans l'ancien projeet
coltrouv = celluletrouvee.Column 'colonne de l'objet dans l'ancien projet
' MsgBox "Cellule trouvée, correspondant à " & monitor & " dans l'OBDMAP (ligne " & k & ", colonne " & l & ")."
For i = 1 To DernCol
colonne = snewFSM.Cells(2, i).Value 'nom de la colonne i dans la nouvelle FSM
Set colonnetrouvee = soldFSM.Range("2:2").Find(colonne, LookIn:=xlValues) 'recherche de la colonne i dans l'ancienne FSM
If Not colonnetrouvee Is Nothing Then
lig = colonnetrouvee.Row
col = colonnetrouvee.Column
' MsgBox "Nom de colonne trouvé à la ligne " & lig & " et à la colonne " & col & "."
soldFSM.Cells(ligtrouv, col).Copy _
Destination:=snewFSM.Cells(A, i)
Else
' MsgBox "Nom de colonne pas trouvé, colonne à laisser vide."
End If
Next
A = A + 1
' MsgBox objet & "trouvé à la ligne " & ligne & " à la colonne = " & col
End If
End If
Next
Next
' Restauration des configurations :
Application.ScreenUpdating = BoEcran
Application.DisplayAlerts = BoAlert
Application.DisplayStatusBar = BoBarre
Application.Calculation = iCalcul
Application.EnableEvents = BoEvent
snewFSM.DisplayPageBreaks = BoSaut
fin = Time
temps = fin - debut
MsgBox "Remplissage terminée." & Chr(10) & "Temps d'exécution : " & temps
End Sub