création macro excel vers TXT

création macro excel vers TXT - Logiciels - Windows & Software

Marsh Posté le 30-07-2014 à 09:51:30    

Bonjour,
J’ai un tableau sous excel. Certaines colonnes m’intéressent d’autres non .
J’aimerai pouvoir choisir les colonnes qui m’intéressent et les regrouper dans un fichier .txt via une macro. Cela m’éviterai de créer un nouveau fichier exel avec que les colonnes qui m’intéressent et ensuite enregistrer ce fichier exel en .txt . Me comprenez vous ?
 
Voila les colonnes que je voudrais incorporer dans le fichier macro sachant que les autres colonnes de mon tableau ne m’intéressent pas.
- Colonne de E9 à E104
- Colonne de H9 à H104
- Colonne de I9 à I104
- Colonne de J9 à J104
- Colonne de K9 à K104
- Colonne de L9 à L104
- Colonne de M9 à M104
 
Mon fichier excel se nomme France 1. Quelqu'un aurait déjà un macro toute prête avec juste les nom de plage à changer ?
Merci pour votre aide

Reply

Marsh Posté le 30-07-2014 à 09:51:30   

Reply

Marsh Posté le 30-07-2014 à 13:50:11    

bonjour,
 
tu peux essayer d'arranger ce petit bout de code
 
Sub fictxt()
'
Application.ScreenUpdating = False
'on supprime le fichier si il existe
If Dir("repertoire et nom du fichier txt" ) = "nom du fichier txt" Then Kill ("repertoire et nom du fichier txt" )
 
On Error Resume Next
 
colonne = ActiveCell.Column
ligne = ActiveCell.Row
 
For Each Cell In Range("Q16", "Q32" )
'je transforme des numerique en texte
    Num = Val(Ref.Value)
    If Num < 100 Then
        nomimpg = "0000" & Num
    Else
    If Num < 1000 Then
        nomimpg = "000" & Num
    Else
     If Num < 10000 Then
        nomimpg = "00" & Num
    Else
     If Num < 100000 Then
        nomimpg = "0" & Num
    Else
    nomimpg = Trim(Num)
    End If
    End If
    End If
    End If
' test ajout des references dans le fichier repertoire et nom du fichier txt
    Open "repertoire et nom du fichier txt" For Append As #1
    Print #1, nomimpg
    Close #1
Next
End Sub


Message édité par forceone1 le 30-07-2014 à 15:10:57
Reply

Marsh Posté le 31-07-2014 à 14:27:11    

Merci beaucoup c'est juste un peu compliqué pour moi car je suis totalement débutant dans ce domaine .  
Ca ne fonctionne pas rien n’apparaît  je vous montre ce que j'ai modifié .
 
Sub fictxt()
'
Application.ScreenUpdating = False
'on supprime le fichier si il existe
If Dir("C:\Documents and Settings\pendarie\Bureau\Macro essai" ) = "macro 1.txt" Then Kill ("C:\Documents and Settings\pendarie\Bureau\Macro essai" )
 
On Error Resume Next
 
colonne = ActiveCell.Column
ligne = ActiveCell.Row
 
For Each Cell In Range("Q16", "Q32" )
'je transforme des numerique en texte
    Num = Val(Ref.Value)
    If Num < 100 Then
        nomimpg = "0000" & Num
    Else
    If Num < 1000 Then
        nomimpg = "000" & Num
    Else
     If Num < 10000 Then
        nomimpg = "00" & Num
    Else
     If Num < 100000 Then
        nomimpg = "0" & Num
    Else
    nomimpg = Trim(Num)
    End If
    End If
    End If
    End If
' test ajout des references dans le fichier repertoire et nom du fichier txt
    Open "repertoire et nom du fichier txt" For Append As #1
    Print #1, nomimpg
    Close #1
Next
End Sub

Reply

Marsh Posté le 31-07-2014 à 14:54:22    

bonjour,
 
me suis trompe sur un point, au niveau de num = val(ref.value), il faut mettre val(cell.value) a la place
 
essaye ce code, je viens de le tester ca marche de mon cote
 
Sub fictxt()
'
Application.ScreenUpdating = False
'on supprime le fichier si il existe
If Dir("C:\test_macro\macro_1.txt" ) = "macro_1.txt" Then Kill ("C:\test_macro\macro_1.txt" )
   
On Error Resume Next
   
colonne = ActiveCell.Column
ligne = ActiveCell.Row
   
For Each cell In Range("Q16", "Q32" )
'je transforme des numerique en texte
    Num = Val(cell.Value)
    If Num < 100 Then
        nomimpg = "0000" & Num
    Else
    If Num < 1000 Then
        nomimpg = "000" & Num
    Else
     If Num < 10000 Then
        nomimpg = "00" & Num
    Else
     If Num < 100000 Then
        nomimpg = "0" & Num
    Else
    nomimpg = Trim(Num)
    End If
    End If
    End If
    End If
' test ajout des references dans le fichier repertoire et nom du fichier txt
    Open "C:\test_macro\macro_1.txt" For Append As #1
    Print #1, nomimpg
    Close #1
Next
End Sub
 

Reply

Marsh Posté le 13-08-2014 à 20:58:56    

Bonjour à tous,
C'est la première que j'utilise un forum.
J'ai une question où ca fait plusieurs mois que je n'ai pas trouvé de solution.
Je suis un débutant en VBA. et j'ai un problème avec une macro.
J'ai une liste avec plusieurs lignes et je veux répartir ces lignes dans différent tableau selon différent critères.
J'ai réaliser une boucle qui marche très bien.  
Mais au deuxième j'ai une ligne qui ne marche pas comme au premier tour.
 
Voici ma macro:
 
Sub liste()
 
Sheets("D05" ).Select
 
FindeLigne = ActiveSheet.UsedRange.Rows.Count + 1
Numeroligne = 1
Co = Sheets("FEmai" ).Range("A4" ).End(xlDown).Row + 1
Co1 = Sheets("FEmai" ).Range("A33" ).End(xlDown).Row + 1
Co2 = Sheets("FEmai" ).Range("A58" ).End(xlDown).Row + 1
Co3 = Sheets("FEmai" ).Range("A208" ).End(xlDown).Row + 1
 
While Numeroligne < FindeLigne
 
Sheets("D05" ).Select
Range("A" & Numeroligne, "J" & Numeroligne).Select
Selection.Copy
 
If Sheets("D05" ).Range("I" & Numeroligne).Value = "AMB" Then
Sheets("FEmai" ).Select
Range("A" & Co).Select
ActiveSheet.Paste
Range("A4" ).Select
End If
 
If Sheets("D05" ).Range("I" & Numeroligne).Value = "T" Then
Sheets("FEmai" ).Select
Range("A" & Co1).Select
ActiveSheet.Paste
Range("A4" ).Select
End If
 
If Sheets("D05" ).Range("I" & Numeroligne).Value = "TM" Then
Sheets("FEmai" ).Select
Range("A" & Co2).Select
ActiveSheet.Paste
Range("A4" ).Select
End If
 
If Sheets("D05" ).Range("I" & Numeroligne).Value = "VSL" Then
Sheets("FEmai" ).Select
Range("A" & Co3).Select
ActiveSheet.Paste
Range("A4" ).Select
End If
 
Numeroligne = Numeroligne + 1
 
Wend
 
End Sub
 
Le problème se trouve sur la ligne : Range("A" & Co).Select
car CO ou CO1 ... = il y a Sheets("FEmai" ).Range("A4" ).End(xlDown).Row + 1
Sur le premier tour de la boucle le +1 marche
mais sur le deuxieme tour c'est comme si la formule ne prenait pas en considération le +1.
 
Si une personne pourrait m'aider se serai super sympa.
Merci et j'espère que la description de mon problème est assez clair.

Reply

Marsh Posté le 18-11-2014 à 15:35:18    

forceone1 a écrit :

bonjour,
 
me suis trompe sur un point, au niveau de num = val(ref.value), il faut mettre val(cell.value) a la place
 
essaye ce code, je viens de le tester ca marche de mon cote
 
Sub fictxt()
'
Application.ScreenUpdating = False
'on supprime le fichier si il existe
If Dir("C:\test_macro\macro_1.txt" ) = "macro_1.txt" Then Kill ("C:\test_macro\macro_1.txt" )
   
On Error Resume Next
   
colonne = ActiveCell.Column
ligne = ActiveCell.Row
   
For Each cell In Range("Q16", "Q32" )
'je transforme des numerique en texte
    Num = Val(cell.Value)
    If Num < 100 Then
        nomimpg = "0000" & Num
    Else
    If Num < 1000 Then
        nomimpg = "000" & Num
    Else
     If Num < 10000 Then
        nomimpg = "00" & Num
    Else
     If Num < 100000 Then
        nomimpg = "0" & Num
    Else
    nomimpg = Trim(Num)
    End If
    End If
    End If
    End If
' test ajout des references dans le fichier repertoire et nom du fichier txt
    Open "C:\test_macro\macro_1.txt" For Append As #1
    Print #1, nomimpg
    Close #1
Next
End Sub
 


 
 
Bonjour,
Je n'avais pas vu votre réponse. Merci beaucoup mais je n'ai rien qui s'affiche à nouveau. Je vous explique comment j'ai fait.
J'ai crée un cercle puis affecter un macro , nouvelle macro et la j'ai fais un copier coller le la macro que vous m'avez donné. Ensuite je la lance le petit curseur de chargement apparait pendant 1 seconde puis rien. J'oublie une étape? Cordialement  

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed