• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kapalı dosyaya veri aktarma

S

selcuk23

Katılım
26 Kasım 2017
Mesajlar
61
Excel Vers. ve Dili
C#
Merhabalar, aşağıdaki kodla aynı çalışma içerisindeki sayfaya veri aktarıyorum. bunun üzerinde yapılacak değişiklikle verileri farklı bir klasördeki tabloya veri aktarabilirmiyim.. verileri alt alta kaydedecek şekilde veri aktaracağım dosya yolu :
‪D:\FİİLİ HİZMET ZAMMI\PUANTAJ 5510.xlsm



Private Sub CommandButton4_Click()
Sheets("fazla çalışma izini").Select
If Range("a3") = "" Or Range("e3") = "" Or Range("f4") = "" Then
MsgBox "Eksik Bilgi Girdiniz!" & vbNewLine & "-İsim, İzin Başlayış Tarihi ve İzinli Gün Süresi- verilerini kontrol ediniz!", vbExclamation, "Uyarı"
Exit Sub
Else
adi_soyadi = Sayfa12.Cells(Rows.Count, 2).End(xlUp).Row + 1
Sayfa12.Cells(adi_soyadi, 2).Value = Sheets("fazla çalışma izini").Range("a3").Value
Sayfa12.Cells(adi_soyadi, 2).Offset(0, 1).Value = Sheets("fazla çalışma izini").Range("e3").Value
Sayfa12.Cells(adi_soyadi, 2).Offset(0, 2).Value = Sheets("fazla çalışma izini").Range("f3").Value
Sayfa12.Cells(adi_soyadi, 2).Offset(0, 3).Value = Sheets("fazla çalışma izini").Range("f4").Value
End If
MsgBox "Aktarma işlemi tamamlandı LÜTFEN İZİN TAKİP SAYFASINA GİDİP İZİN TÜRÜNÜ SECİN!", vbInformation, "Bilgi"
End Sub
 
hocam denemedim ama sanırım böyle birşey işinizi görebilir. bende kapalı bir dosyadan veri çektiğim bir makro kullanıyorum. aynı mantığı kurmaya çalıştım. verileri çektiğiniz kitabın ismini bilmediğim için yazamadım. Sheets("fazla çalışma izini") kısımlarının başına workbooks ismini eklerseniz daha sağlıklı olabilir.

Kod: 
Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
Sheets("fazla çalışma izini").Select
If Range("a3") = "" Or Range("e3") = "" Or Range("f4") = "" Then
MsgBox "Eksik Bilgi Girdiniz!" & vbNewLine & "-İsim, İzin Başlayış Tarihi ve İzinli Gün Süresi- verilerini kontrol ediniz!", vbExclamation, "Uyarı"
Exit Sub
Else
Dim adi_soyadi
Dim Yol
Yol = ‪D:\FİİLİ HİZMET ZAMMI\PUANTAJ 5510.xlsm
Workbooks.Open (Yol)
adi_soyadi = Workbooks("PUANTAJ 5510"). Sayfa12.Cells(Rows.Count, 2).End(xlUp).Row + 1
Workbooks("PUANTAJ 5510"). Sayfa12.Cells(adi_soyadi, 2).Value = Sheets("fazla çalışma izini").Range("a3").Value
Workbooks("PUANTAJ 5510"). Sayfa12.Cells(adi_soyadi, 2).Offset(0, 1).Value = Sheets("fazla çalışma izini").Range("e3").Value
Workbooks("PUANTAJ 5510"). Sayfa12.Cells(adi_soyadi, 2).Offset(0, 2).Value = Sheets("fazla çalışma izini").Range("f3").Value
Workbooks("PUANTAJ 5510"). Sayfa12.Cells(adi_soyadi, 2).Offset(0, 3).Value = Sheets("fazla çalışma izini").Range("f4").Value
End If
Application.ScreenUpdating = True
MsgBox "Aktarma işlemi tamamlandı LÜTFEN İZİN TAKİP SAYFASINA GİDİP İZİN TÜRÜNÜ SECİN!", vbInformation, "Bilgi"
End Sub
 
Malesef aktarma yapmadı. hata veriyor .. bilgileri aktaracağı yol :

‪C:\Users\ab141234\Desktop\Kitap1.xlsx
 
Yol ="‪C:\Users\ab141234\Desktop\Kitap1.xlsx" şeklinde tırnak içerisinde deneyin.
 
Eklediğim dosyada mı hata verdi?
Dosya yolu, dosya adı ve sayfa adında bir eksiklik yoksa hata vermemesi gerekti

https://hizliresim.com/JQg3Rj

Kod: 
[SIZE="2"]Private Sub CommandButton3_Click()
Sheets("İZİN BELGESİ").Select
If Range("a3") = "" Or Range("e3") = "" Or Range("f4") = "" Then
MsgBox "Eksik Bilgi Girdiniz!" & vbNewLine & "-İsim, İzin Başlayış Tarihi ve İzinli Gün Süresi- verilerini kontrol ediniz!", vbExclamation, "Uyarı"
Exit Sub
Else
Dim DOSYA As String
Dim aç, hz
Dim hzs As Worksheet, rw As Long
DOSYA = [COLOR="Blue"]ThisWorkbook.Path & "\" & "PUANTAJ 5510.xlsm[/COLOR]"
Set aç = New Excel.Application
On Error Resume Next
aç.Workbooks.Open DOSYA
Set hz = aç.Workbooks(Dir(DOSYA))
Set hzs = [COLOR="Blue"]hz.Sheets("izin takip")[/COLOR]
rw = hzs.Cells(Rows.Count, "A").End(3).Row + 1
hzs.Range("A" & rw).Value = Range("A3").Value
hzs.Range("B" & rw).Value = Range("E3").Value
hzs.Range("C" & rw).Value = Range("F3").Value
hzs.Range("D" & rw).Value = Range("F4").Value
hz.Close SaveChanges:=True
aç.Quit
Set aç = Nothing: Set hz = Nothing
If Err <> 0 Then
MsgBox "Bir hata oluştu"
Else
MsgBox "Aktarma işlemi tamamlandı!", vbInformation, "Bilgi"
End If
End If

End Sub[/SIZE]
 
Mrh.. Kodu dosyaya uyarlayıp çalıştırdığımda hata vermedi. ancak bugün tekrar açtığımda (Microsoft Excel başka bir uygulamanın OLE eylemini tamamlamasını bekliyor) diyerek donuyor. 10 dakika sonra (Ne yazık ki D:\ C:\users\1234\Deskop\PUANTAJ 5510.xlsm' sitesini acamadık) diye uyarıyor
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst