Soru Kopyalanmış art arda gelen çoklu hücre satırının araya birer hücrelik boşluk bırakılarak yapıştırılması..

[Hilal0]

"Kopyalanmış art arda gelen çoklu hücre satırının araya birer hücrelik boşluk bırakılarak yapıştırılması.."
Nasıl mümkündür bu?

 

[Korhan Ayhan]

Örnek dosya paylaşarak yapmak istediğiniz işlemi açıklar mısınız?

 

[Hilal0]

Örnek dosya paylaşarak yapmak istediğiniz işlemi açıklar mısınız?

Link
Yapmak istediğimi belge içinde de ayrıca gösterdim..

 

[Korhan Ayhan]

Bu işlemi makro ile yapmanız daha uygun görünüyor.

Aşağıdaki kodu deneyiniz.

Kodu çalıştırdığınızda sizden kopyalamak istediğiniz alanı seçmenizi isteyecek.
Bu aşamadan sonra seçtiğiniz alanı nereye yapıştırmak istediğinizi soracak. Burada yapıştırmak istediğiniz alanın ilk hücresini seçmeniz yeterli olacaktır.

Son aşamada verileriniz değer olarak istediğiniz alanda listelenecektir.

Option Explicit

Sub Bosluklu_Aktar()
    Dim Kopyalanacak_Alan As Range
    Dim Yapistirilacak_Hucre As Range
    Dim Dizi As Variant, X As Long, Y As Integer, Say As Long
    
    On Error Resume Next
    Set Kopyalanacak_Alan = Application.InputBox("Lütfen kopyalamak istediğiniz alanı seçiniz.", Type:=8)
    On Error GoTo 0
    
    If Kopyalanacak_Alan Is Nothing Then Exit Sub
    
    On Error Resume Next
    Set Yapistirilacak_Hucre = Application.InputBox("Lütfen listenin yapıştırılacağı ilk hücreyi seçiniz.", Type:=8)
    On Error GoTo 0
    
    If Yapistirilacak_Hucre Is Nothing Then Exit Sub
    
    Dizi = Kopyalanacak_Alan.Value

    ReDim Liste(1 To UBound(Dizi, 1) * 2, 1 To UBound(Dizi, 2))

    For X = LBound(Dizi, 1) To UBound(Dizi, 1)
        Say = Say + 1
        For Y = LBound(Dizi, 2) To UBound(Dizi, 2)
            Liste(Say, Y) = Dizi(X, Y)
        Next
        Say = Say + 1
        For Y = LBound(Dizi, 2) To UBound(Dizi, 2)
            Liste(Say, Y) = ""
        Next
    Next
    
    Range(Yapistirilacak_Hucre.Address).Resize(Say, UBound(Liste, 2)) = Liste
    
    Set Kopyalanacak_Alan = Nothing
    Set Yapistirilacak_Hucre = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Hilal0]

Bu işlemi makro ile yapmanız daha uygun görünüyor.

Aşağıdaki kodu deneyiniz.

Kodu çalıştırdığınızda sizden kopyalamak istediğiniz alanı seçmenizi isteyecek.
Bu aşamadan sonra seçtiğiniz alanı nereye yapıştırmak istediğinizi soracak. Burada yapıştırmak istediğiniz alanın ilk hücresini seçmeniz yeterli olacaktır.

Son aşamada verileriniz değer olarak istediğiniz alanda listelenecektir.

Option Explicit

Sub Bosluklu_Aktar()
    Dim Kopyalanacak_Alan As Range
    Dim Yapistirilacak_Hucre As Range
    Dim Dizi As Variant, X As Long, Y As Integer, Say As Long
   
    On Error Resume Next
    Set Kopyalanacak_Alan = Application.InputBox("Lütfen kopyalamak istediğiniz alanı seçiniz.", Type:=8)
    On Error GoTo 0
   
    If Kopyalanacak_Alan Is Nothing Then Exit Sub
   
    On Error Resume Next
    Set Yapistirilacak_Hucre = Application.InputBox("Lütfen listenin yapıştırılacağı ilk hücreyi seçiniz.", Type:=8)
    On Error GoTo 0
   
    If Yapistirilacak_Hucre Is Nothing Then Exit Sub
   
    Dizi = Kopyalanacak_Alan.Value

    ReDim Liste(1 To UBound(Dizi, 1) * 2, 1 To UBound(Dizi, 2))

    For X = LBound(Dizi, 1) To UBound(Dizi, 1)
        Say = Say + 1
        For Y = LBound(Dizi, 2) To UBound(Dizi, 2)
            Liste(Say, Y) = Dizi(X, Y)
        Next
        Say = Say + 1
        For Y = LBound(Dizi, 2) To UBound(Dizi, 2)
            Liste(Say, Y) = ""
        Next
    Next
   
    Range(Yapistirilacak_Hucre.Address).Resize(Say, UBound(Liste, 2)) = Liste
   
    Set Kopyalanacak_Alan = Nothing
    Set Yapistirilacak_Hucre = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Çok çok teşekkür ederim emeğinize sağlık.