Merhabalar. Bu konuda yeniyim. Elimde liste olan bir dosya var ve bu dosyadaki listeyi belirli bölümlere ayırıyorum ve masa üstüne aşagıdaki kodla kaydediyorum. Liste olan( ana liste ) dosya aktif ve bunun a1:aj2 satırları arasında başlıklar var. bu başlıklarıda yeni dosyanın a1:j2 satırları arasına kopyalamasını istiyorum. aynı zamanda a3 satırından itibaren J sutununa kadar da binlerce veri var ve bunların bulunduğu hücrelerede kenarlık çizmesini istiyorum. Bu kodlara eklemem gerekiyor. Yardımcı olursanız sevinirim.
AKTARMA KODU :
Private Sub CommandButton1_Click()
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set NewWB = xlApp.Workbooks.Add
Set MySh = NewWB.Worksheets(1)
nRow = ListBox1.ListCount
nColumn = ListBox1.ColumnCount
MySh.Range("A3", Cells(nRow, nColumn).Address) = ListBox1.List
WBname = "C:\Users\Hp\Desktop\" & (TextBox1.Text) & ".xlsx"
NewWB.SaveAs WBname
MsgBox WBname & " Adında Bir Excel Dosyası oluşturulmuştur...", _
vbInformation, "BOLU İL ÖZEL İDARESİ"
xlApp.Quit
Set xlApp = Nothing
Set MySh = Nothing
Set NewWB = Nothing
End Sub
AKTARMA KODU :
Private Sub CommandButton1_Click()
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set NewWB = xlApp.Workbooks.Add
Set MySh = NewWB.Worksheets(1)
nRow = ListBox1.ListCount
nColumn = ListBox1.ColumnCount
MySh.Range("A3", Cells(nRow, nColumn).Address) = ListBox1.List
WBname = "C:\Users\Hp\Desktop\" & (TextBox1.Text) & ".xlsx"
NewWB.SaveAs WBname
MsgBox WBname & " Adında Bir Excel Dosyası oluşturulmuştur...", _
vbInformation, "BOLU İL ÖZEL İDARESİ"
xlApp.Quit
Set xlApp = Nothing
Set MySh = Nothing
Set NewWB = Nothing
End Sub
Son düzenleme: