Kopyalarken boş hücreleri silme

[yNsr43]

Merhaba arkadaşlar. a1 - d7 arasi tabloyu kopyalayip not defterine aktarmam gerekiyor ama aralarda bazi boş hücreler olduğu için anlamsiz bir boşluk oluyor bunu nasıl halledebiliriz ? " " gibi

teşekkürler.

 

[Ömer]

Merhaba,

Makro ile yapabilirsiniz. ayrc değişkenini ben vbTab olarak belirledim, siz kendinize göre değiştirebilirsiniz. Excelin kayıtlı olduğu klasöre deneme isminde txt dosyası kaydeder.

Sub test()

    Dim i As Long, j As Integer, deg As String, ayrc As String, alan
   
    Open ThisWorkbook.Path & "\" & "deneme" & ".txt" For Output As #1
   
    alan = Split(Range("A1:D7").Address, ":")
   
    For i = Range(alan(0)).Row To Range(alan(1)).Row
        deg = ""
        For j = Range(alan(0)).Column To Range(alan(1)).Column
            If Cells(i, j) <> "" Then
                ayrc = vbTab
                If deg = "" Then ayrc = ""
                deg = deg & ayrc & Cells(i, j)
            End If
        Next j
        If deg <> "" Then Print #1, deg
    Next i
   
    Close #1

End Sub

 

[yNsr43]

Öncelikle elinize sağlık, şöyle bir durum oluştu sayıların arasındaki noktaları kaldırıyor ve yüzdelik sayıları ondaliğa çeviriyor onları nasıl halledebiliriz. birde düzenlemeyi yaptiktan sonra txt kaydetmek yerine clipboard'a kopyalamak mümkünmü
ilgilendiğiniz için teşekkür ederim,

 

[Ömer]

Deneyiniz.

Sub test()

    Dim i As Long, j As Integer, deg As String, deg1 As String, ayrc As String, alan, frmt, obj As Object
      
    Set obj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    alan = Split(Range("A1:D7").Address, ":")
  
    For i = Range(alan(0)).Row To Range(alan(1)).Row
        deg = ""
        For j = Range(alan(0)).Column To Range(alan(1)).Column
            If Cells(i, j) <> "" Then
                ayrc = vbTab
                If deg = "" Then ayrc = ""
                frmt = Cells(i, j).NumberFormat
                If frmt = "General" Then frmt = ""
                deg = deg & ayrc & Format(Cells(i, j), frmt)
            End If
        Next j
        ayrc = Chr(10)
        If deg1 = "" Then ayrc = ""
        If deg <> "" Then deg1 = deg1 & ayrc & deg
    Next i
  
    obj.SetText deg1
    obj.PutInClipboard
    
End Sub

 

[yNsr43]

teşekkür ederim elinize sağlık.