Ouverture, extraction copie le tout en background
LULUX57
-
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
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:
- Ouverture, extraction copie le tout en background
- Copie cachée - Guide
- Super copie - Télécharger - Gestion de fichiers
- Copie écran samsung - Guide
- Copie disque dur - Guide
- Page d'ouverture google - Guide
1 réponse
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 ...
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 ...