Satır arası boşluk oluşturma

[FBI1985]

Merhaba arkadaşlar bu forumdaki ilk konum olacak
excelde 1200 satırlık bir veri var ve bu verilerin iki satır iki satır olması ve arada bir boşluk olması gerekiyor bunu tek tek satır ekle yöntemiyle yaparsam malumunuz baya uzun sürecek daha önce tek tek satır aralarına boşluk ekleyen makro kodu buldum ama bana ikişerli gurup olacak şekilde lazım yardımcı olursanız sevinirim teşekkürler.

 

[BedriA]

Merhaba arkadaşlar bu forumdaki ilk konum olacak
excelde 1200 satırlık bir veri var ve bu verilerin iki satır iki satır olması ve arada bir boşluk olması gerekiyor bunu tek tek satır ekle yöntemiyle yaparsam malumunuz baya uzun sürecek daha önce tek tek satır aralarına boşluk ekleyen makro kodu buldum ama bana ikişerli gurup olacak şekilde lazım yardımcı olursanız sevinirim teşekkürler.

Foruma hoşgeldiniz.
Örnek bir dosya ekleyebilir misiniz?

http://dosya.co/

 

[FBI1985]

Foruma hoşgeldiniz.
Örnek bir dosya ekleyebilir misiniz?

http://dosya.co/

Hoşbulduk teşekkürler

http://dosya.co/at75o9g1kdv0/ESAT.xls.html

 

[BedriA]

Hoşbulduk teşekkürler

http://dosya.co/at75o9g1kdv0/ESAT.xls.html

Ekteki dosyayı indirip inceleyiniz.
Bu dosyayı açın.
Veri Aktar butonu ile 2 satır ara ile boşluk bırakmak istediğiniz dosyayı seçin.
Ardından Boşlukları Sil butonuna basın.
Son olarak da 2 Satır Ara İle Boşluk Bırak butonuna basın.

Örnek.xlsm - 128 KB

 

[FBI1985]

Hocam çok teşekkürler tam olarak istediğim de bu fakat bunu nasıl yaptınız anlatabilir misiniz rica etsem

 

[ridvanucok]

Ekteki dosyayı indirip inceleyiniz.
Bu dosyayı açın.
Veri Aktar butonu ile 2 satır ara ile boşluk bırakmak istediğiniz dosyayı seçin.
Ardından Boşlukları Sil butonuna basın.
Son olarak da 2 Satır Ara İle Boşluk Bırak butonuna basın.

Örnek.xlsm - 128 KB

Üstadım,

Şirkette olduğum için dosya paylaşım sitelerinden dosya indiremiyorum. Siteye'de ek olarak ekler misiniz?

Teşekkürler & İyi çalışmalar.

 

[FBI1985]

????????????

 

[BedriA]

Üstadım,

Şirkette olduğum için dosya paylaşım sitelerinden dosya indiremiyorum. Siteye'de ek olarak ekler misiniz?

Teşekkürler & İyi çalışmalar.

4 nolu mesaja ekledim.

 

[BedriA]

Kullanılan kodlar aşağıdaki gibidir.

Hocam çok teşekkürler tam olarak istediğim de bu fakat bunu nasıl yaptınız anlatabilir misiniz rica etsem

Private Sub CommandButton2_Click() [COLOR="Red"]'Boşluk bırakır.[/COLOR]

ss = Range("a2").End(3).Row
For i = ss To 2400 Step 3
    Cells(i, 1).EntireRow.Insert
Next
End Sub

Private Sub CommandButton3_Click()[COLOR="red"] 'Dosya aktarır.[/COLOR]

Dim conn As Object, rs As Object, sonsat As Long

On Error GoTo hata
ChDir ThisWorkbook.Path

Dosya = Application.GetOpenFilename(FileFilter:="," & _
        "*.xls;*.xlsx;*.xlsm", _
        Title:="Lütfen dosya seçimi yapınız") ' uzantı eklemeleri yapabilirsiniz
    If Dosya = False Then ' eğer vazgeçe basarsanız
        MsgBox "Dosya seçme işleminden vazgeçildi.", vbInformation, "         Bilgi"
        Exit Sub
    Else


Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("Adodb.recordset")

        
Application.ScreenUpdating = False
    conn.Open ("provider=microsoft.ace.oledb.12.0;data source=" & _
            Dosya & ";extended properties=""excel 12.0;hdr=no""")
    rs.Open "select * from [Sayfa1$A1:K65000];", conn, 1, 1
    If rs.RecordCount > 0 Then
        sonsat = Cells(Rows.Count, "B").End(xlUp).Row
        Range("A" & sonsat + 1).CopyFromRecordset rs
        
    End If
    rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
Range("A1:K65000").HorizontalAlignment = xlCenter
Range("A1:K65000").VerticalAlignment = xlCenter

MsgBox "Veriler aktarıldı.", vbInformation, "         Bilgi"
End If
Exit Sub
 
hata:
    MsgBox "Klasör bulunamadı", vbCritical, "        UYARI"

End Sub

Private Sub CommandButton4_Click() [COLOR="red"]'A ve D sütunlarındaki verirleri siler.[/COLOR]
 Columns("A:D").Select
    Selection.ClearContents
End Sub



Private Sub CommandButton5_Click() [COLOR="red"]'Boşlukları siler.[/COLOR]
[a:a].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Kod yazamıyorum henüz ancak bulduğum kodları bazen istediğim şeye uyarlayabiliyorum.
Şansınıza bu defa uğraşınca oldu.