Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1680 connectés 

  FORUM HardWare.fr
  Windows & Software
  Logiciels

  création macro excel vers TXT

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

création macro excel vers TXT

n°3134596
rem81
Posté le 30-07-2014 à 09:51:30  profilanswer
 

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

mood
Publicité
Posté le 30-07-2014 à 09:51:30  profilanswer
 

n°3134608
forceone1
Posté le 30-07-2014 à 13:50:11  profilanswer
 

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
n°3134706
rem81
Posté le 31-07-2014 à 14:27:11  profilanswer
 

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

n°3134708
forceone1
Posté le 31-07-2014 à 14:54:22  profilanswer
 

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
 

n°3135671
neo222816
Posté le 13-08-2014 à 20:58:56  profilanswer
 

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.

n°3148259
rem81
Posté le 18-11-2014 à 15:35:18  profilanswer
 

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  


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Windows & Software
  Logiciels

  création macro excel vers TXT

 

Sujets relatifs
Formule excelExcel - Fichier avec mot de passe sur USB
Excel : fonction INDIRECT sur une colonne et erreur #ref!Cartes dans excel ??
partager un fichier excelannuler déplacement dossier système vers lecteur D:
Aide a la creation d'un serveur pour une PMEfaire un fichier excel ou word avec mes musiques
Raccourcis clavier Excel - écriture début fonctionVersion Excel - 32 ou 64 bits ?
Plus de sujets relatifs à : création macro excel vers TXT


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR