belli aralıktaki verileri kopyalayıp dışarı aktarma

[recepsukut]

1-
Private Sub CommandButton1_Click()

Dim wb As Workbook
Dim ur As Worksheet
Dim urss As Long
Dim sor As Byte




If Option1.Value = True Then

sor = MsgBox("ürün listesi dışarı aktarılsın mı?", vbQuestion + vbYesNo, "dışarı aktar")
If sor = vbNo Then Exit Sub
Set ur = Sheets("Urunler")
urss = ur.Range("A100000").End(xlUp).Row

Set wb = Workbooks.Add
ThisWorkbook.Sheets("Urunler").Copy before:=wb.Sheets(1)
wb.SaveAs ThisWorkbook.Path & "\Export Files\Ürün Listesi.xlsx"
wb.Close
Set wb = Nothing
MsgBox "Ürün Listesi Dışarı Aktarıldı"
End If

--------------------------------------------------------------------


2-
If Option2.Value = True Then

sor = MsgBox("ürün listesi dışarı aktarılsın mı?", vbQuestion + vbYesNo, "dışarı aktar")
If sor = vbNo Then Exit Sub
Set ur = Sheets("Urunler")
urss = ur.Range("B1:H1").End(xlUp).Row

Set wb = Workbooks.Add
ThisWorkbook.Sheets("Urunler").Range("B:H").Copy before:=wb.Sheets(1) ----> burada bir hata mı yapıyorum ?
wb.SaveAs ThisWorkbook.Path & "\Export Files\Ürün Listesi.xlsx"
wb.Close
Set wb = Nothing
MsgBox "Ürün Listesi Dışarı Aktarıldı"
End If


End Sub



1'deki kod çalışıyor fakat 2deki kod dışarı aktarmıyor 2nci kodda b ve h hücrelerini dışarı aktarmak istiyorum yardımcı olurmusunuz ?

 

[Korhan Ayhan]

Merhaba,

Öncelikle profilinizde yazan "Excel Vers. ve Dili orta seviye" kalın olarak belirttiğim ofis sürümü bilgisini güncellemenizi rica ediyorum. (Örnek : Ofis 2010 TR 32 Bit gibi)

Çalışmıyor dediğiniz bölümde ki urss = ur.Range("B1:H1").End(xlUp).Row satırı sanırım bir işe yaramıyor. Silebilirsiniz.

Verileri kopyalayan satırı da aşağıdaki gibi değiştirip deneyiniz.

ur.Range("B:H").Copy wb.Sheets(1).Range("A1")