Macro Excel avec création d'onglet et copie d'information ciblé

Fermé
Sylvain - 5 févr. 2016 à 21:21
Le Pingou Messages postés 12064 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 5 mai 2024 - 6 févr. 2016 à 16:21
Bonjour,

J'essaie de créer une macro qui me permet d'ouvrir un fichier .txt et le convertir en excel. Puisque ce document contient plusieurs sous-titres, je cherche à séparer en différents onglets tous les sous-titres qui sont listé dans la colonne A. J'aimerais que le tout soit automatisé et mes sous-titres ne sont jamais pareils d'une extraction à l'autre. Je vous copie ma macro ci-dessous. Pour l'instant j'ai réussi à créer mes onglets automatiquement. Mon questionnement maintenant, est comment je peux copier et coller l'information correspondant aux sous-titres.

Pouvez-vous m'aider?

Voici ma macro :P

Dim VarNomRepertoire
Dim ClasseurCsv
Dim OngletProrata



Sub MACROPROTOTYPE1()
'
' MACROPROTOTYPE1 Macro
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For ctrOnglet = Sheets.Count To 1 Step -1

varNomOnglet = Sheets(ctrOnglet).Name
If InStr(1, UCase(varNomOnglet), "FINAL") = 0 And InStr(1, UCase(varNomOnglet), "PRORATA") = 0 _
And InStr(1, UCase(varNomOnglet), "BOUTON") = 0 Then

' Sheets("2014PU-INUDXEF").Select
' ActiveWindow.SelectedSheets.Delete
Sheets(ctrOnglet).Delete


End If
Next
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("PRORATA").Select
Set OngletProrata = Worksheets("PRORATA")
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select
Sheets("BOUTON").Select
VarNomRepertoire = ThisWorkbook.Path & "\"
Workbooks.OpenText Filename:=VarNomRepertoire & "PRORATA_20160202Scq.txt", DataType:=xlDelimited, semicolon:=True
Set ClasseurCsv = Worksheets(1)
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
OngletProrata.Activate
Range("A1").Select
ActiveSheet.Paste
ClasseurCsv.Activate
ActiveWindow.Close
Sheets("PRORATA").Select
Range("A1").Select

' Columns("A:A").Select
' Selection.Find(What:="NOM_ONGLET", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
VarNbrLigneTotal = Selection.Count
For ctrLigne = 1 To VarNbrLigneTotal


If ActiveCell = "NOM_ONGLET" Then

ActiveCell.Offset(1, 0).Activate
varNomOnglet = ActiveCell.Value

Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = varNomOnglet

OngletProrata.Activate


Else
varAdresse = ActiveCell.Address
ctrLigneOng = 1
End If
ActiveCell.Offset(1, 0).Activate
Next

End Sub

A voir également:

1 réponse

Le Pingou Messages postés 12064 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 5 mai 2024 1 431
6 févr. 2016 à 16:21
Bonjour,
Au passage, la procédure ne permet pas de vous aider et en plus sans avoir au minimum le fichier [TXT]…

0