Listbox verilerini başlıklı olarak Excel sayfasına aktarmak

[tamer42]

Merhaba,
Aşağıdaki kod ile Listbox' ta bulunan verileri yeni bir excel dosyasına aktarabiliyorum,
yalnız bu işlem esnasında Listbox sütun başlıklarını (ColumnHeads=True) nasıl aktaracağımzı yapamadım.

verileri sütun başlıkları ile birlikte aktarmak istiyordum, yardımcı olursanız sevinirim.

Private Sub CommandButton1_Click()
   With Workbooks.Add
        .Sheets(1).Range(Cells(1, 1), Cells(Me.ListBox1.ListCount, Me.ListBox1.ColumnCount)) = _
            Me.ListBox1.List
        Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    End With
End Sub

iyi Çalışmalar.

 

[Korhan Ayhan]

Merhaba,

En pratik yolu önce başlık satırını kopyalamaktır.

Kendinize uyarlarsınız.

Private Sub CommandButton1_Click()
    Dim Baslik As Range
   
    Set Baslik = Range("A1:E1")
   
    With Workbooks.Add
        Baslik.Copy .Sheets(1).Cells(1, 1)
        .Sheets(1).Range(Cells(2, 1), Cells(Me.ListBox1.ListCount + 1, Me.ListBox1.ColumnCount)) = _
        Me.ListBox1.List
        Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    End With
End Sub

 

[tamer42]

Merhaba,

En pratik yolu önce başlık satırını kopyalamaktır.

Kendinize uyarlarsınız.

Private Sub CommandButton1_Click()
    Dim Baslik As Range
  
    Set Baslik = Range("A1:E1")
  
    With Workbooks.Add
        Baslik.Copy .Sheets(1).Cells(1, 1)
        .Sheets(1).Range(Cells(2, 1), Cells(Me.ListBox1.ListCount + 1, Me.ListBox1.ColumnCount)) = _
        Me.ListBox1.List
        Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    End With
End Sub

Korhan Hocam aşağıdaki gibi bir yöntem denedim ama hata verdi, belki üzerinde küçük revizyonlarla sonuç laınabilir.

  Range(Me.ListBox1.RowSource).Offset(-1, 0).Copy .Sheets(1).Range(Cells(1, 1), Cells(1, b))

 

[Korhan Ayhan]

Deneyiniz.

RowSource bölümünü aşağıdaki gibi kullanırsanız sizin dediğiniz gibi çözüme gidilebilir.

Option Explicit

Private Sub CommandButton1_Click()
    With Workbooks.Add
        .Sheets(1).Range(Cells(1, 1), Cells(Me.ListBox1.ListCount + 1, Me.ListBox1.ColumnCount)) = _
        Range(Me.ListBox1.RowSource).Offset(-1).Resize(Me.ListBox1.ListCount + 1, 5).Value
        Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    End With
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        .ColumnCount = 5
        .ColumnWidths = "70;70;70;70;70"
        .ColumnHeads = True
        .RowSource = Sheets("Sheet1").Range("A2:E20").Address(External:=True)
    End With
End Sub

 

[tamer42]

Deneyiniz.

RowSource bölümünü aşağıdaki gibi kullanırsanız sizin dediğiniz gibi çözüme gidilebilir.

Option Explicit

Private Sub CommandButton1_Click()
    With Workbooks.Add
        .Sheets(1).Range(Cells(1, 1), Cells(Me.ListBox1.ListCount + 1, Me.ListBox1.ColumnCount)) = _
        Range(Me.ListBox1.RowSource).Offset(-1).Resize(Me.ListBox1.ListCount + 1, 5).Value
        Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    End With
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        .ColumnCount = 5
        .ColumnHeads = True
        .RowSource = Sheets("Sheet1").Range("A2:E20").Address(External:=True)
    End With
End Sub

Teşekkürler Korhan Hocam

 

[Korhan Ayhan]

Örnek dosyayı da paylaştım.