Macro Excel avec création d'onglet et copie d'information ciblé
Sylvain
-
Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention -
Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention -
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
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:
- Macro Excel avec création d'onglet et copie d'information ciblé
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Word et excel gratuit - Guide
- Liste déroulante excel - Guide
- Copie cachée - Guide
- Si et excel - Guide