aktarma

[talatcd]

Slm arkadaşlar ben veri aktarma için aşağıdaki kodu uyguladım.
Private Sub CommandButton1_Click()
Dim NewXL As Excel.Application
Dim DataWB As String
Dim NoA As Long
Dim Wb As Workbook

Set NewXL = New Excel.Application
NewXL.Visible = False
DataWB = ThisWorkbook.Path & Application.PathSeparator & "C:Ekders\Puantaj.xls"
Set Wb = NewXL.Workbooks.Open(DataWB)
NoA = Wb.Sheets(1).Cells(65536, 1).End(xlUp).Row + 1

With Wb.Sheets(1)
.Range("A" & NoA) = Sheets(1).Range("A2")
.Range("B" & NoA) = Sheets(1).Range("B2")
.Range("C" & NoA) = Sheets(1).Range("C2")
.Range("D" & NoA) = Sheets(1).Range("D2")
.Range("E" & NoA) = Sheets(1).Range("E2")
.Range("F" & NoA) = Sheets(1).Range("F2")
.Range("G" & NoA) = Sheets(1).Range("G2")
End With

NewXL.Workbooks(Dir(DataWB)).Close SaveChanges:=True

Set Wb = Nothing
Set NewXL = Nothing
End Sub
siyah yazılı bölümde hata oluştu onu nasıl çözebilirm. Yardımcı olurmusunuz.

Ekli Dosyadada görüleceği gibi buradaki Puntj adlı dosyanın sayfa1 ini C:\Ekders Klasöründeki Puantaj dosyasının Sayfa 1 ine atmak istiyorum Saygılar

 

[Haluk]

Burası yanlış olmuş ....

DataWB = ThisWorkbook.Path & Application.PathSeparator & "C:Ekders\Puantaj.xls"

Eğer, Puantaj.xls dosyası, kodun çalıştığı kitap ile aynı klasördeyse aşağıdaki gibi kullanın.

DataWB = ThisWorkbook.Path & Application.PathSeparator & "Puantaj.xls"

Yok, öyle değil diyorsanız o zaman aşağıdakini deneyin ...

DataWB = "C:\Ekders\Puantaj.xls"

 

[talatcd]

İlgin için çok teşekkür ediyorum. aynı klasörde değiller Aktarılacak= C:\Ekders klasörü içinde Puantaj.xls dosyasının sayfa1 ine , A:\ dan ana.xls nin sayfa1 ini aktarmak istiyorum. Sizin tarif ettiğiniz gibi yaptım yine

Set Wb = NewXL.Workbooks.Open(DataWB)

Bu kodda hata verdi bu sorunumu çözersen sevinirim. Saygılar.

 

[Haluk]

Eğer bu kodlar, C:\Ekders\Puantaj.xls dosyasındaysa ve sizin dataları aktaracağınız da A:\ana.xls dosyası ise;

DataWB = "A:\ana.xls" olarak deneyin ...

 

[talatcd]

"A:\ana.xls" Buradan
C:\Ekders\Puantaj.xls buraya aktarmak istiyorum .

 

[Haluk]

Eğer bu kodlar, C:\Ekders\Puantaj.xls dosyasındaysa ve sizin dataları aktaracağınız da A:\ana.xls dosyası ise;

DataWB = "A:\ana.xls" olarak deneyin ...

Bu şekilde denediniz mi ?

 

[talatcd]

Saol Haluk bey işin çoğunu hallettim şimdilik bir satırı aktarıyor. Diğer satırları da aktarması için nasıl bir formül gerekli ve aynı isimde formatı aynı başka disketler geldikce alt alta ekleyerek gitmesi.

Benim Þu anki formülüm bu ;

Private Sub CommandButton1_Click()
Dim NewXL As Excel.Application
Dim DataWB As String
Dim NoA As Long
Dim Wb As Workbook

Set NewXL = New Excel.Application
NewXL.Visible = False
DataWB = "C:\Ekders\Puantaj.xls"
Set Wb = NewXL.Workbooks.Open(DataWB)
NoA = Wb.Sheets(1).Cells(65536, 1).End(xlUp).Row + 1

With Wb.Sheets(1)
.Range("A" & NoA) = Sheets(1).Range("A9")
.Range("B" & NoA) = Sheets(1).Range("B9")
.Range("C" & NoA) = Sheets(1).Range("C9")
.Range("D" & NoA) = Sheets(1).Range("D9")
.Range("E" & NoA) = Sheets(1).Range("E9")
.Range("F" & NoA) = Sheets(1).Range("F9")
.Range("G" & NoA) = Sheets(1).Range("G9")
End With

NewXL.Workbooks(Dir(DataWB)).Close SaveChanges:=True

Set Wb = Nothing
Set NewXL = Nothing
End Sub