Eviter répétition code

gourdin · 1 Octobre 2016

Bonjour,

Ci dessous le code qui me permet d'ouvrir le fichier "tablo.txt" et de l'alimenter avec les 3 premières cellules de la colonne D de mon fichier excel.
Comment éviter de répéter le code "Range("")" pour chaque différentes cellules de ma colonne D (sachant qu'il peut y avoir de très nombreuses cellules dans la colonne D)

Sub fichier_text()
Filename = ThisWorkbook.Path & "\tablo.txt"
Open Filename For Output As #1
Print #1, Range("D1")
Print #1, Range("D2")
Print #1, Range("D3")
Close #1
End Sub

Merci

pierrejean · 1 Octobre 2016

bonjour gourdin
A tester
2 possibilités selon le nombre :

Code:

Sub fichier_text()
Filename = ThisWorkbook.Path & "\tablo.txt"
Open Filename For Output As #1
For n = 1 To 3
  Print #1, Range("D" & n)
Next
Close #1
End Sub

Sub fichier_text()
table = Array(1, 2, 3, 5, 7)
Filename = ThisWorkbook.Path & "\tablo.txt"
Open Filename For Output As #1
For n = LBound(table) To UBound(table)
  Print #1, Range("D" & table(n))
Next
Close #1
End Sub

gourdin · 1 Octobre 2016

Merci Pierre Jean
C'est parfait.
Bonne week end

Staple1600 · 2 Octobre 2016

Bonjour à tous, pierrejean

Une troisième possibilité (pour ceux qui comme n'aime les boucles que sur les têtes des damoizelles en goguette )

VB:

Sub a()
Dim Filename$, objDO As New MSForms.DataObject
'cocher la référence à Microsoft Forms 2.0 Object Library
Filename = ThisWorkbook.Path & "\tablo.txt"
Columns("D:D").Copy: objDO.GetFromClipboard
strDATA = objDO.GetText
Open Filename For Output As #1
Print #1, strDATA;
Close #1
End Sub

mapomme · 2 Octobre 2016

Bonjour à tous,

Pour le fun.
Attention! Ne fonctionne que si la source a au plus 65 536 cellules (à cause de l'utilisation de Transpose)

VB:

Sub fichier_text()
   Open ThisWorkbook.Path & "\tablo.txt" For Output As #1
   Print #1, Join(Application.WorksheetFunction.Transpose(Range("d1:d" & Cells(Rows.Count, "d").End(xlUp).Row)), vbNewLine)
   Close #1
End Sub

Eviter répétition code

gourdin

XLDnaute Impliqué

pierrejean

XLDnaute Barbatruc

gourdin

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Discussions similaires