Ouverture, extraction copie le tout en background

LULUX57 -  
 LULUX57 -
Bonjour,

Cela fait 2 semaines que je me suis mis serieusement à faire des Macro sous excel mais la je ne trouve plus solution à mon probleme.

J'ai un fichier "data_brut.xls" qui contient un sheet de plus de 3000 ligne et 10 colonnes non formaté.
j'ai un second fichier dans lequel j'exploite les données du premier fichier et qui contient mes macros.
Dans le fichier data_brut la derniere colonne contient une date au format jj.mm.aaaa hh:mm:ss non formaté
J'ai deux cellules (P3 et Q3) du fichier "cible" qui contient deux dates servant d'interval.

Je souhaite faire une extraction des lignes comprises dans mon interval et les copier vers le classeur cible dans la feuille cible.
Sans que rien ne soit visible bien entendu :

cidessous le code qui bloque

rappel je debute désolé pour les erreurs de debutant :

Sub prep_date()

Dim xl As Object
Dim wb As Object
Dim Fsource As Worksheet
Dim Fdestin As Worksheet

Set Fsource = ActiveSheet
Set Fdestin = ThisWorkbook.Sheets("data_cible")

' ouverture du fichier en background

Set xl = CreateObject("Excel.Application")
xl.Visible = False
Set wb = xl.Workbooks.Open(Filename:="c:\work\data_brut.xls", ReadOnly:=False)

Worksheets("sheet1").Activate

' formatage de la date

Dim g As Range, d As String, erreurs As String

For Each g In Range([J1], [J65536].End(xlUp))
d = Replace(g, ".", "/")
If IsDate(d) Then
g = Format(d, "d/m/yyyy hh:mm:ss")
Else
erreurs = erreurs & g.Row & "-"
End If
Next g



End Sub

Sub Filtre_date()

Sheets("data_brut").Select

Dim datedeb, datefin, heuredeb, heurefin, dateX, heureX As Date
Dim chemin, mot_clef1, mot_clef2 As String
Dim choix As Integer
Dim DateCible As Date

i = 1: choix = 1

LaDerniere = Range("A65536").End(xlUp).Row
mot_clef1 = Worksheets("data_cible").Range("P3").Value
Temps = Split(mot_clef1, " ")
datedeb = Temps(0)
heuredeb = Temps(1)

mot_clef2 = Worksheets("data_cible").Range("Q3").Value
Temps2 = Split(mot_clef2, " ")
datefin = Temps2(0)
heurefin = Temps2(1)


For i = 1 To 500 ' LaDerniere
DateCible = FormatDateTime(Workbooks("fichier_cible.xls").Worksheets("data_cible").Cells(i, 10).Value)
TempsX = Split(DateCible, " ")
dateX = TempsX(0)
heureX = TempsX(1)

If ((datedeb < dateX) And (dateX > datefin)) Then

Cells(i, 1).Resize(1, 10).Copy

Workbooks("fichier_cible.xls").Worksheets("data_cible").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("data_brut").Select

Else
Workbooks("fichier_cible.xls").Worksheets("data_cible").Cells(i, 12).Value = ("Date non-comprise dans l'interval")
End If
Next i


End Sub


A voir également:

1 réponse

LULUX57
 
Pour info j'ai modifié le debut de mon code avec :


Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wb = xl.Workbooks.Open(Filename:="c:\work\data_brut.xls", ReadOnly:=False)

On Error Resume Next
Workbooks("data_brut.xls").Activate
If Err <> 0 Then
MsgBox "data_brut.xls n'est pas ouvert"
Else: MsgBox "data_brut.xls est ouvert"
End If

Mais il m'affiche toujours qu'il n'est pas ouvert alors que je le vois bien sur mon bureau ??
ça peu expliquer pourquoi il ne fait pas la suite ...
0