Bonjour et merci encore de prendre le temps de m'aider.
Je suis capable de copier la feuil1 dans le fichier bd.xls
mais sa prend une éternité a faire puis comparer avec mon for j'ai le temp de prendre un café .. lol j'ai lu sur
le site Lire et écrire dans les classeurs Excel fermés - Club d'entraide des développeurs francophones
comment lire un fichier fermer mais moi je doit faire une comparaison des cellule avec for ubound la je sais plus trop quoi faire ....
Je suis capable de copier la feuil1 dans le fichier bd.xls
mais sa prend une éternité a faire puis comparer avec mon for j'ai le temp de prendre un café .. lol j'ai lu sur
le site Lire et écrire dans les classeurs Excel fermés - Club d'entraide des développeurs francophones
comment lire un fichier fermer mais moi je doit faire une comparaison des cellule avec for ubound la je sais plus trop quoi faire ....
Code:
Sub Find_Matches()
Dim TableFu As Range, TableTRY As Range, TableMrp As Range, no_fu As Range, no_mrp As Range, LastTRY As Integer, LastFu As Integer, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, trouve As Object
Dim BD As Workbook, Now As Workbook
Set ws1 = ActiveWorkbook.Sheets("fukanban")
Set ws2 = ActiveWorkbook.Sheets("TRY")
Set ws3 = ActiveWorkbook.Sheets("liste")
Set TableMrp = Selection
tablo = TableMrp.value
Application.ScreenUpdating = False
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=D:\keven\désuetude\bd.xls;Mode=Share Deny Write;Extended " _
, _
"Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Ty" _
, _
"pe=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New D" _
, _
"atabase Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compa" _
, "ct=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False") _
, Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Feuil1$")
.Name = "bd"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "D:\keven\désuetude\bd.xls"
.Refresh BackgroundQuery:=False
End With
tablo2 = Sheets("Feuil1").Range("A2:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
For n = LBound(tablo) To UBound(tablo)
For m = LBound(tablo2) To UBound(tablo2)
If tablo(n, 1) = tablo2(m, 1) Then
Sheets("Feuil1").Range("A" & m + 1 & ":D" & m + 1).Copy Destination:=Sheets("TRY").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next m
Next n
Application.DisplayAlerts = False
Sheets("Feuil1").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub