Copier toutes les lignes après une chaine de caractères dans un txt

[r0man0]

Bonjour, j'avais résolu mon problème il y a qqtemps en substituant la ligne de code qui m'aurait satisfaite par un startrow.
Sauf que, mes fichiers txt ont été modifié et les lignes d'intérêt qui avant commençaient toujours au même rang, commencent maintenant à n'importe quel rang, ce qui m'agace.
Or toutes ces lignes qui m'intéressent commence juste après une chaine de caractère qui elle ne change jamais, voilà j'aimerai pouvoir modifier ma macro pour pouvoir copier que les lignes qui se trouvent sous "FPL 00"

Sub Importtxt()
    Dim MyFile, MyPath, MyName
    Dim Cell As Range
    Application.ScreenUpdating = False
    Sheets("Compilation").Select
    Cells.ClearContents
    Sheets("Main_Sheet").Select
    Cells.ClearContents
    NomDuFichierOrigine = ActiveWorkbook.Name
    Répertoire = ActiveWorkbook.Path & "\"
    Sheets("Main_Sheet").Range("A1:A1000").Value = ""
    CompteurFichier = 1
    MyFile = Dir(Répertoire & "*.txt")
    Sheets("Main_Sheet").Cells(CompteurFichier, 1) = MyFile
    CompteurFichier = CompteurFichier + 1
    Do Until MyFile = ""
    MyFile = Dir
    If MyFile <> NomDuFichierOrigine Then
    Sheets("Main_Sheet").Cells(CompteurFichier, 1) = MyFile
    CompteurFichier = CompteurFichier + 1
    End If
    Loop
    With Sheets("Main_Sheet")
        For Each Cell In .Range("A1:A" & .Range("A65536").End(xlUp).Row)
            NomDuFichier = Cell
            NomCompletDuFichierAOuvrir = Répertoire & Cell
            Workbooks.OpenText Filename:= _
            NomCompletDuFichierAOuvrir, Origin:= _
            xlMSDOS, StartRow:=4, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
            , ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:= _
            False, Space:=True, Other:=True, Otherchar:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1) _
            , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1) _
            , Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1)), TrailingMinusNumbers _
            :=True
        ActiveSheet.Range("A1:M" & ActiveSheet.Range("A65536").End(xlUp).Row).Copy
        Workbooks(NomDuFichierOrigine).Sheets("Compilation").Range("A" & Workbooks(NomDuFichierOrigine).Sheets("Compilation").Range("A65536").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
        Application.DisplayAlerts = False
        Workbooks(NomDuFichier).Close savechanges:=False
        Application.DisplayAlerts = True
        Next
    End With
Sheets("Main_Sheet").Select
End Sub

Voilà, après moult recherche, si vous pouviez m'indiquer qu'elle itinéraire prendre, merci.

 

[Zon]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Salut,

Tu peux fixer ton startrow à 1

et faire une boucle pour tester quand on trouve PFL, et copier à partir de la ligne du dessous:

            , Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1)), TrailingMinusNumbers _
            :=True
i=1
while cells(i,1)<>"PFL"
i=i+1
wend
        ActiveSheet.Range("A" i+1 & ":M" & ActiveSheet.Range("A65536").End(xlUp).Row).Copy

A+++

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Merci pour cette réponse mais finalement j'ai tout pris dans un premier temps et dans un second temps j'ai fait une suppression ligne par ligne en commençant par celle du bas en lui posant comme condition si la ligne commence par un mot différent de fpl on supprime la ligne entière, encore merci.

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Re-bonjour, j'ai pas mal modifié mon code, cependant je bloque sur quelque chose, en effet j'aimerai poser une condition si mon n est supérieur à 300 lignes alors il écrit les x premières lignes jusqu'à un mot précis puis les y lignes suivantes jusqu'à un autre mot précis, par exemple un trajet le havre paris, ma première plage irait de la cellule havre à la cellule rouen et la seconde de la cellule rouen à la cellule paris, j'avais commencé quelque chose mais sans succès, je ne trouve pas la solution à mon problème.

Sub FICELLERTE()

Dim Destination As Range
Dim MaPlage As Range
Dim Fs As Object, U As Object
Dim k As Long
Dim compteur As Integer
Dim Result As Integer
Dim ErrMsg As String
Dim Choices As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Work_Sheet_2).Select
Cells.ClearContents
Sheets(RTE_FLITESTAR).Select
Cells.ClearContents
Sheets(Compilation).Select
Set Destination = Sheets(Work_Sheet_2).Range(A1)
Set MaPlage = Sheets(Compilation).Range(A1M & Sheets(Compilation).Range(A65536).End(xlUp).Row)
Set tbl = ActiveCell.CurrentRegion
Set Fs = CreateObject(Scripting.FileSystemObject)
Set U = Fs.CreateTextFile(Etudespublic03_MISSION01_PREPARATION_MISSIONOUTIL ROUTE FLITESTARRouteRTE_FLITESTAR.rte, True)



tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
MaPlage.Copy Destination
Sheets(Work_Sheet_2).Select

Range(N1).FormulaR1C1 = 1

Cells.Find(, after=[A1], LookIn=xlFormulas, LookAt=xlPart, SearchOrder=xlByRows, searchdirection=xlPrevious, _
MatchCase=False, SearchFormat=False).Select

n = Selection.Row

If n 299 Then
MsgBox (Dépassement de la capacité de traitement ROUTE (300))
With Sheets(RTE_FLITESTAR)
For compteur = 1 To n Step 300
U.WriteLine (.Range(A & compteur).Value)
Next compteur
End With
End If
MsgBox (Export ROUTE réussi)

For i = 1 To n
Cells(i, 14).FormulaR1C1 = _
=R[-1]C+1
Cells(i, 15).FormulaR1C1 = _
=RC[-9]+((500RC[-8]+3RC[-7])30000)
Cells(i, 17).FormulaR1C1 = _
=RC[-7]+((500RC[-6]+3RC[-5])30000)
Cells(i, 16).FormulaR1C1 = _
=IF(RC[-11]=s,-RC[-1],RC[-1])
Cells(i, 18).FormulaR1C1 = _
=IF(RC[-9]=W,-RC[-1],RC[-1])
Cells(i, 20).FormulaR1C1 = _
=CONCATENATE(W, 0, ,C[-6],, ,C[-6],,,C[-16], , ,C[-4],, ,C[-2],,39154.4176025, 111, 4, 5, 255, 13158342,0, 0, 0)
Next i

Range(T1T65000).Copy

Sheets(RTE_FLITESTAR).Columns(AA).PasteSpecial Paste=xlPasteValues, Operation=xlNone, SkipBlanks=False, Transpose=False

Sheets(RTE_FLITESTAR).Select
For j = 1 To 5
Rows(11).Insert Shift=xlDown, CopyOrigin=xlFormatFromLeftOrAbove
Next j

Range(A1).FormulaR1C1 = OziExplorer Route File Version 1.0
Range(A2).FormulaR1C1 = WGS 84
Range(A3).FormulaR1C1 = Reserved 1
Range(A4).FormulaR1C1 = Reserved 2
Range(A5).FormulaR1C1 = R, 0,R0 ,,255

With Sheets(RTE_FLITESTAR)
For k = 1 To .Cells(.Rows.Count, A).End(xlUp).Row
U.WriteLine (.Range(A & k).Value)
Next k

U.Close
Set A = Nothing
Set Fs = Nothing
End With
Sheets(Main_Sheet).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox (Export ROUTE réussi)

End Sub

PS : Si dans le même temps vous pouviez voir pour alléger mon code ça me serait d'une grande aide, merci.

 

[Zon]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Salut,

Un fichier exemple serait le bienvenu...comment je sais moi le havre Paris à partir de ton code ?

D'aprés ce que je vois, tu écris toutes les 300 lignes dans ton fichier texte si N>299...

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Salut,
désolé je ne peux t'envoyer de fichier, même démarquer, en revanche je peux te dire qu'il s'agit d'une plage de données de 50 à 500 lignes, chaque lignes correspondant à un point de passage géoreférencé, comme des waypoints sur un gps, en faîtes j'aimerai pouvoir lui dire, si il compte plus de 300 étapes, "comme la tu vas dépasser ta limite d'affichage, tu vas prendre toutes mes étapes du premier à celle que je vais t'indiquer dans une combobox et tu vas m'écrire mon fichier .rte, et tu vas prendre toutes mes étapes de celle que je t'ai indiqué à la dernière et tu vas m'écrire mon fichier .rte" voilà, grossomodo.
Sachant que dans ma plage j'ai une colonne "nom" qui correspond aux abréviations que j'utilise pour mes étapes, et que j'aimerai utiliser pour ma condition d'écriture.
Merci.

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Bonjour,
J'ai trouvé une solution, mais ça ne fonctionne pas, bon je crois avoir fait des erreurs mais j'avoue que mes yeux et mon esprit fatigue un peu, je post le code,

Sub FICELLERTE()

Dim Destination, MaPlage, PL, R, DEST As Range
Dim Fs, U As Object
Dim FIC, ErrMsg, mot, PA As String
Dim K As Long
Dim Result, Choices, DL As Integer


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Work_Sheet_2").Select
Cells.ClearContents
Sheets("RTE_FLITESTAR").Select
Cells.ClearContents
Sheets("Compilation").Select
Set Destination = Sheets("Work_Sheet_2").Range("A1")
Set MaPlage = Sheets("Compilation").Range("A1:M" & Sheets("Compilation").Range("A65536").End(xlUp).Row)
Set tbl = ActiveCell.CurrentRegion


tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
MaPlage.Copy Destination

With Sheets("Work_Sheet_2")

Range("N1").FormulaR1C1 = "1"

Cells.Find("*", after:=[A1], LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Select

n = Selection.Row
mot = InputBox("Donnez code OACI")
DL = .Cells(Application.Rows.Count, 1).End(xlUp).Row
Set PL = .Range("T1:T" & DL)
Set R = PL.Find(mot, , xlValues, xlWhole)
End With

If Not R Is Nothing Then
PA = R.adress

With Sheets("RTE_FLITESTAR")
Set DEST = IIf(.Cells(1, 1) = "", .Cells(1, 1), .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
End With

With Sheets("Work_Sheet_2")
If n > 299 Then
MsgBox ("Dépassement de la capacité de traitement ROUTE (>300)")
For compteur = 1 To PA
.Range("T1:T" & compteur).Value.Copy DEST
Next compteur
End If
End With

For i = 1 To n
Cells(i, 14).FormulaR1C1 = _
"=R[-1]C+1"
Cells(i, 15).FormulaR1C1 = _
"=RC[-9]+((500*RC[-8]+3*RC[-7])/30000)"
Cells(i, 17).FormulaR1C1 = _
"=RC[-7]+((500*RC[-6]+3*RC[-5])/30000)"
Cells(i, 16).FormulaR1C1 = _
"=IF(RC[-11]=""s"",-RC[-1],RC[-1])"
Cells(i, 18).FormulaR1C1 = _
"=IF(RC[-9]=""W"",-RC[-1],RC[-1])"
Cells(i, 20).FormulaR1C1 = _
"=CONCATENATE(""W, 0, "",C[-6],"", "",C[-6],"","",C[-16],"" , "",C[-4],"", "",C[-2],"",39154.4176025, 111, 4, 5, 255, 13158342,0, 0, 0"")"
Next i

Range("T1:T65000").Copy

Sheets("RTE_FLITESTAR").Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets("RTE_FLITESTAR").Select
For j = 1 To 5
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next j

Range("A1").FormulaR1C1 = "OziExplorer Route File Version 1.0"
Range("A2").FormulaR1C1 = "WGS 84"
Range("A3").FormulaR1C1 = "Reserved 1"
Range("A4").FormulaR1C1 = "Reserved 2"
Range("A5").FormulaR1C1 = "R, 0,R0 ,,255"

Set Fs = CreateObject("Scripting.FileSystemObject")
Set U = Fs.CreateTextFile("\\Etudes\public\03_MISSION\01_PREPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route\RTE_FLITESTAR.rte", True)
With Sheets("RTE_FLITESTAR")
For K = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
On Error GoTo Errorhandler
U.WriteLine (.Range("A" & K).Value)
Next K

Errorhandler:

Select Case Err.Number

Case 13:
ErrMsg = "Une erreur est survenue ligne " & K - 5 & " de la feuille Compilation."

Result = MsgBox(ErrMsg, Choices)

If Result = vbOK Then
Resume Next
End If
End Select
U.Close
Set U = Nothing
Set Fs = Nothing
NOM = InputBox("Donnez un nom de fichier.wpt")
If NOM = "" Then
Exit Sub
Else
GoTo continu
End If
continu:
FIC = Dir("\\Etudes\public\03_MISSION\01_PREPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route\RTE_FLITESTAR.rte")
If FIC <> "" Then Name "\\Etudes\public\03_MISSION\01_PREPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route\" _
& FIC As "\\Etudes\public\03_MISSION\01_PREPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route\" & NOM & ".rte"
End With
Sheets("Main_Sheet").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox ("Export ROUTE réussi")
End If
End Sub

En faite, j'appel une fenêtre qui me demande de taper mon mot clé, elle le cherche, le trouve, l'identifie dans ma plage et lance une copie de la ligne 1 à la ligne contenant mon mot clé gràce à mon compteur vers ma feuille RTE_FLITESTAR, et pareil de la ligne de mon mot clé à la dernière ligne.
Bon ça commence à devenir laborieux pour moi, je sèche complètement.

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Bonjour, je cherche toujours, je vais bien finir par trouver!

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Bonjour, Zon, que penses-tu de mon code?

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Bonjour, quelqu'un pourrait m'aider svp.

 

[Yaloo]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Bonjour r0man0, le forum,

Comment te dire, tout en restant diplomate

Zon te demande un fichier, le 11/09

Salut,
Un fichier exemple serait le bienvenu...

Depuis ce temps-là, toujours pas de fichier.

Bonjour,
J'ai trouvé une solution, mais ça ne fonctionne pas, bon je crois avoir fait des erreurs mais j'avoue que mes yeux et mon esprit fatigue un peu, je post le code, ...

Tant mieux, si tu as trouvé une solution, le problème ce n'est pas une solution puisque ça ne fonctionne pas ....

Bonjour, je cherche toujours, je vais bien finir par trouver!

Continue, tu vas sûrement y arriver ...

Bonjour, Zon, que penses-tu de mon code?

Je pense que Zon à laisser tomber depuis longtemps (début du fil 06/08/2012 quand même ....)

Bonjour, quelqu'un pourrait m'aider svp.

Sans fichier, je ne pense pas.


Mais c'est bien tu es tenace, tu vas y arriver

A+

Martial

Edit : Salut Job, même idée

 

[job75]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Bonjour R0man0,

Bonjour, je cherche toujours, je vais bien finir par trouver!

Après 6 mois vous n'avez toujours pas compris la règle du jeu

Perso, quand je vois un code de plus de 100 lignes sans le moindre fichier joint, je fuis vite fait.

Edit : salut Yaloo.

A+

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Bonjour, désolé c'est ici que je bloque sur cette partie du code :

Cells.Find(, after=[A1], LookIn=xlFormulas, LookAt=xlPart, SearchOrder=xlByRows, searchdirection=xlPrevious, _
MatchCase=False, SearchFormat=False).Select

n = Selection.Row

If n 299 Then
MsgBox (Dépassement de la capacité de traitement ROUTE (300))
With Sheets(RTE_FLITESTAR)
For compteur = 1 To n Step 300
U.WriteLine (.Range(A & compteur).Value)
Next compteur
End With
End If
MsgBox (Export ROUTE réussi)

 

[r0man0]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Bonjour, je respectes les règles, mais après avoir été récalcitrant trop longtemps plus personnes ne veut me donner une chance, désolé d'avoir été un noobs, je cherche juste un coup de main sioux plait...

 

[Zon]

Re : Copier toutes les lignes après une chaine de caractères dans un txt

Salut tout le monde,


Moi aussi je ne vais pas respecter les règles du forum, bon à priori ton fichier est trop gros pour le forum.


écris-moi en private afin que l'on traite en courriel.

A+++