excel den txt aktarırken bosluk ayarlama

[hhd82]

Merhaba excelde bir sayfada a b c sutunlarında asagıdakı gibi veriler var
yazıdakı kod ıle txt aktarım yapıyordum 1 er satır bosluk koyarak cıkarıyordu Txt olarak
bunu su sekılde yapabilirmiyim .
1 satır bosluk
2.satır bosluk

3.satır ve 17.satır arasında bosluk olmayacak

tekrar bosluk ve 28.satır olarak Txt ye cıkartabilirmiyim.

Dim deg As String, i As Long, st As Long, j As Byte


st = Cells(Rows.Count, "A").End(xlUp).Row

dosya = Worksheets("veri").Range("G3").Value & ".txt"
Open (Environ("USERPROFILE") & "\Desktop\" & "\" & dosya) For Output As #1
For i = 1 To st
If Cells(i, 1).Value <> "" Then
    For j = 1 To 5
        deg = deg & " " & Cells(i, j)
    Next j
    deg = Right(deg, Len(deg) - 1)
        Print #1, deg: deg = "": Print #1, deg
        End If
  Next i
Close #1
'MsgBox Worksheets("veri").Range("G3").Value & " numaralı bilgi notu olusturuldu." & vbLf & ""
UserForm3.Show
Shell "notepad.exe " & Environ("USERPROFILE") & "\Desktop\" & "/" & dosya
Sheets("anasayfa").Select

A1	B1	C1
A2	B2	C2
A3	B3	C3
A4	B4	C4
A5	B5	C5
A6	B6	C6
A8	B8	C8
A9	B9	C9
A10	B10	C10
A11	B11	C11
A12	B12	C12
A13	B13	C13
A14	B14	C14
A15	B15	C15
A16	B16	C16
A17	B17	C17
A28	B28	C28

 

[hhd82]

bu kodla boşlukları sıldım ben 2.satır 4.satır ve 10. satıra bir bosluk eklemek ısıtıyorum nasıl cozum bulabilirim.

Sub Makro1()
'
Dim deg As String, i As Long, st As Long, j As Byte


st = Cells(Rows.Count, "A").End(xlUp).Row

dosya = Worksheets("sayfa1").Range("G3").Value & ".txt"
Open (Environ("USERPROFILE") & "\Desktop\" & "\" & dosya) For Output As #1
For i = 1 To st
If Cells(i, 1).Value <> "" Then
    For j = 1 To 5
        deg = deg & " " & Cells(i, j)
    Next j
    deg = Right(deg, Len(deg) - 1)
         Print #1, deg: deg = "":
        End If
  Next i
Close #1
'MsgBox Worksheets("veri").Range("G3").Value & " numaralılusturuldu." & vbLf & ""

Shell "notepad.exe " & Environ("USERPROFILE") & "\Desktop\" & "/" & dosya


End Sub

 

[netzone]

Merhaba,

Aşağıdaki şekilde deneyiniz.

Sub Makro1()

Dim deg As String, i As Long, st As Long, j As Byte

st = Cells(Rows.Count, "A").End(xlUp).Row

dosya = Worksheets("sayfa1").Range("G3").Value & ".txt"
Open (Environ("USERPROFILE") & "\Desktop\" & "\" & dosya) For Output As #1
For i = 1 To st
If Cells(i, 1).Value <> "" Then
    
    ' 2, 4 ve 10. satırlardan hemen önce boş satır ekler
    If i = 2 Or i = 4 Or i = 10 Then
        Print #1, ""
    End If
    
    For j = 1 To 5
        deg = deg & " " & Cells(i, j)
    Next j
    deg = Right(deg, Len(deg) - 1)
         Print #1, deg: deg = "":
        End If
  Next i
Close #1
'MsgBox Worksheets("veri").Range("G3").Value & " numaralılusturuldu." & vbLf & ""

Shell "notepad.exe " & Environ("USERPROFILE") & "\Desktop\" & "/" & dosya

End Sub

 

[hhd82]

Çok teşekkürler
ilk 2 satırda ayırdı fakat veriler degişken , bosluklar oldugu için 10. satırda ayıramadım.
son satırda Özet kelimesi sabit özet kelimesinden once yada son satırdaki yazıdan once 1 bosluk bırakacak şekilde ayarlayabilirmiyiz.

 

[hhd82]

If i = 2 Or i = 3 Or i = st Then şeklinde sorun çözüldü gibi çok teşekürler

 

[hhd82]

Son satır da da sorun oldu
Satırda özet kelimesi varsa ondan once bosluk koydurabilirmiyiz.