Boş satırları kapatsın

[Akif59]

Merhaba aşağıdaki kod Sheets de belirtilen sayfaya gidip A sütununu masa üstüne txt olarak kaydediyor
fakat gittiği sayfanın A sütununda boş satırlar olabiliyor önce boşları gizleyip txt ondan sonra alsa ve işi bitince gizledikleri tekrar açacak şekilde düzenlenebilir mi


Sub txt()

Sheets("AccuMark Explorer").Select
Dim i, sat As Integer
sat = ActiveSheet.UsedRange.Rows.Count
Open ThisWorkbook.Path & "\" & [b1] & ".txt" For Output As #1
For i = 1 To sat
Print #1, Cells(i, "a") 'a sütun adıdır.
Next i
Sheets("Imalat").Select
Close

End Sub

 

[hmtstc]

For t = 1 to cells(rows.count,1).end(3).row
If cells(t,1)=empty then
Rows(t).entirerow.hidden=true
End if
Next t

Somra sizin kodlar

 

[Akif59]

For t = 1 to cells(rows.count,1).end(3).row
If cells(t,1)=empty then
Rows(t).entirerow.hidden=true
End if
Next t

Somra sizin kodlar
[/QUOTE
Merhaba olmuyor durmaksızın dönüyor

 

[hmtstc]

For t = cells(rows.count,1).end(3).row to 1 step -1
If cells(t,1)=empty then
Rows(t).entirerow.hidden=true
End if
Next t


tersten gelmemiz gerekli sonradan fark ettim

 

[Akif59]

For t = cells(rows.count,1).end(3).row to 1 step -1
If cells(t,1)=empty then
Rows(t).entirerow.hidden=true
End if
Next t


tersten gelmemiz gerekli sonradan fark ettim

Merhaba sizin kodunuzu önce ilgili sayfaya gideceği için aşağıdaki gibi ekliyorum durmaksızın dönüyor 32 gb xeon işlemci %100 cpu hatası veriyor

Sub Droplu_Sipariş()
Sheets("AccuMark Explorer").Select ' Önce bu sayfaya gideceği için sizin kodu bu satırdan sonra ekliyorum

For t = Cells(Rows.Count, 1).End(3).Row To 1 Step -1
If Cells(t, 1) = Empty Then
Rows(t).EntireRow.Hidden = True
End If
Next t

Dim i, sat As Integer
sat = ActiveSheet.UsedRange.Rows.Count
Open ThisWorkbook.Path & "\" & [b1] & ".txt" For Output As #1
For i = 1 To sat
Print #1, Cells(i, "a") 'a sütun adıdır.
Next i
Sheets("Imalat").Select
Close
MsgBox "Droplu Siparişler Hazırlandı", vbInformation, "[AccuMark Explorer]"
Range("I3:K3").Select
End Sub

 

[hmtstc]

hocam ben denedim hata alamadım. üstatlardan yorumları bekleyelim

 

[Akif59]

hocam ben denedim hata alamadım. üstatlardan yorumları bekleyelim

Teşekkür ederin zaman ayırdığınız için

 

[Ömer]

Merhaba,

Döngünün içine if şartı ile boş satırlar hariç diyebilirsiniz.

Sub txt_yeni()

Sheets("AccuMark Explorer").Select
Dim i, sat As Integer
sat = ActiveSheet.UsedRange.Rows.Count
Open ThisWorkbook.Path & "\" & [b1] & ".txt" For Output As #1
For i = 1 To sat
If Cells(i, "a") <> "" Then
Print #1, Cells(i, "a") 'a sütun adıdır.
End If
Next i
Sheets("Imalat").Select
Close

End Sub

 

[Akif59]

Merhaba,

Döngünün içine if şartı ile boş satırlar hariç diyebilirsiniz.

Sub txt_yeni()

Sheets("AccuMark Explorer").Select
Dim i, sat As Integer
sat = ActiveSheet.UsedRange.Rows.Count
Open ThisWorkbook.Path & "\" & [b1] & ".txt" For Output As #1
For i = 1 To sat
If Cells(i, "a") <> "" Then
Print #1, Cells(i, "a") 'a sütun adıdır.
End If
Next i
Sheets("Imalat").Select
Close

End Sub

Merhaba Ömer bey
Elinize sağlık çok güzel oldu teşekkür ederim zaman ayırdığınız için