Aktarma Hatası

[mehmetkoca]

Değerli arkadaşlar;
Yedeklemiş olduğum dosyayı Aşağıdaki kod yardımıyla , ı Genel isimli sayfada ilgili hücreye çift tıklayarak Kapak şablon sayfasına çağırıyordum.Şu an aktaramıyorum sanırım bir sorun var.Yardımcı olursanız sevinirim.Ekteki dosyada diğer kodlar mevcut.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo son
If Intersect(Target, [b5:b150]) Is Nothing Then Exit Sub
dosya1 = ThisWorkbook.Name
dosya2 = Target.Value & " - " & Target.Offset(0, 2).Value & ".xls"
Set S1 = Sheets("KAPAK")
Set S2 = Sheets("GENEL")

Application.DisplayAlerts = False
Dosya_Yolu = "C:\Users\mehmet\Desktop\GENEL" & "\" & dosya2
Workbooks.Open Filename:=Dosya_Yolu

S1.[c3:e3].ClearContents
S1.[c4:e4].ClearContents
S1.[c5:e5].ClearContents
S1.[h3:j3].ClearContents
S1.[h4:j4].ClearContents
S1.[h5:j5].ClearContents
S1.[a7:e7].ClearContents
S1.[a8:e8].ClearContents
S1.[f7:j7].ClearContents
S1.[f8:j8].ClearContents
S1.[c9:e9].ClearContents
S1.[h9:j9].ClearContents
S1.[b11:e35].ClearContents
S1.[g11:j35].ClearContents
S1.[I36:j36].ClearContents
S1.[I38:j38].ClearContents

Workbooks(dosya1).Sheets("KAPAK").Range("h3:h4").Value = Workbooks(dosya2).Sheets("KAPAK").Range("h3:h4").Value
Workbooks(dosya1).Sheets("KAPAK").Range("c4:e4").Value = Workbooks(dosya2).Sheets("KAPAK").Range("c4:e4").Value
Workbooks(dosya1).Sheets("KAPAK").Range("c5:e5").Value = Workbooks(dosya2).Sheets("KAPAK").Range("c5:e5").Value
Workbooks(dosya1).Sheets("KAPAK").Range("c3:e3").Value = Workbooks(dosya2).Sheets("KAPAK").Range("c3:e3").Value
Workbooks(dosya1).Sheets("KAPAK").Range("h4:j4").Value = Workbooks(dosya2).Sheets("KAPAK").Range("h4:j4").Value
Workbooks(dosya1).Sheets("KAPAK").Range("a7:e7").Value = Workbooks(dosya2).Sheets("KAPAK").Range("a7:e7").Value
Workbooks(dosya1).Sheets("KAPAK").Range("a8:e8").Value = Workbooks(dosya2).Sheets("KAPAK").Range("a8:e8").Value
Workbooks(dosya1).Sheets("KAPAK").Range("h5:j5").Value = Workbooks(dosya2).Sheets("KAPAK").Range("h5:j5").Value
Workbooks(dosya1).Sheets("KAPAK").Range("f7:j7").Value = Workbooks(dosya2).Sheets("KAPAK").Range("f7:j7").Value
Workbooks(dosya1).Sheets("KAPAK").Range("f8:j8").Value = Workbooks(dosya2).Sheets("KAPAK").Range("f8:j8").Value
Workbooks(dosya1).Sheets("KAPAK").Range("c9:e9").Value = Workbooks(dosya2).Sheets("KAPAK").Range("c9:e9").Value
Workbooks(dosya1).Sheets("KAPAK").Range("h9:j9").Value = Workbooks(dosya2).Sheets("KAPAK").Range("h9:j9").Value
Workbooks(dosya1).Sheets("KAPAK").Range("b11:e35").Value = Workbooks(dosya2).Sheets("KAPAK").Range("b11:e35").Value
Workbooks(dosya1).Sheets("KAPAK").Range("g11:j35").Value = Workbooks(dosya2).Sheets("KAPAK").Range("g11:j35").Value
Workbooks(dosya1).Sheets("KAPAK").Range("ı36:j36").Value = Workbooks(dosya2).Sheets("KAPAK").Range("ı36:j36").Value
Workbooks(dosya1).Sheets("KAPAK").Range("ı38:j38").Value = Workbooks(dosya2).Sheets("KAPAK").Range("ı38:j38").Value


ActiveWorkbook.Close False
Application.ScreenUpdating = True
S1.Select
S1.[c3].Select
MsgBox "İlgili Sipariş Şablona Aktarıldı..!!", vbOKOnly + vbInformation, "AKTARMA"
son:
If Err.Number <> 0 Then MsgBox "Aktarmada Hata Oluştu ", vbInformation, "Bilgi"
Set S1 = Nothing
Set S2 = Nothing
End Sub

 

[Korhan Ayhan]

Selamlar,

Kodunuzu şimdi test ettim ve bir sorun görünmüyor. Aktarı işlemi yapılıyor. Dosya yollarınızı ve aktarım yapılacak dosyanın olup olmadığını kontrol ediniz.

 

[mehmetkoca]

aktarma hatası

dosyayı ekte yolluyorum.Yardımcı olan arkadaş olursa memnun olurum.
Çift tıklayıp aktarırken sorun aktarmada hata oluşuyor.

Saygılar.

 

[mehmetkoca]

Korhan hocam bakabildinizmi?

 

[mehmetkoca]

Aktarma hatası

Değerli Arkadaşlar ; bu kodun çalışmama sebebi ne olabilir.Hata yok gibi gözüküyor ama kod hata veriyor "Aktarmada hata oluştu" şeklinde.

 

[mehmetkoca]

Dosya adını ve yolunuda kontrol ettim ama hata yine devam ediyor.

 

[mehmetkoca]

Korhan hocam bi yardımcı olabilirmisiniz?

 

[mehmetkoca]

Değerli Hocalarım lütfen yardımcı olurmusunuz , bu hata sebebiyle tıkandım kaldım iyice.

Yardımlarınız için teşekkür ederim.

Saygılarımla

 

[Korhan Ayhan]

Selamlar,

Eklemiş olduğunuz son dosyanın GENEL isimli sayfasında B sütunu boş olduğu için çift tıkladığınızda aktarım yapılacak bir dosya bulamadığından hata vermektedir. Eğer aktarım yaptığınız dosyadan da bir örnek eklerseniz deneme şansımız olabilir.

 

[mehmetkoca]

Hocam siparişi genel sayfasına aktarıyorum ve yedek alıyorum.Ama b sütununda müş.sip.no ya tıkladığımda aktarmada hata oluştu şeklinde hata veriyor.Dosyalar ektedir.

 

[mehmetkoca]

Sanırım bu sorunun çözümü olmayacak.Bir türlü çıkamadım işin içinden.
Başka bir çözüm önerisi olan varmıdır acaba.

 

[mehmetkoca]

Değerli arkadaşlar başka bir önerisi olan yokmudur acaba? Nasıl çıkıcam işin içinden bileemiyorum..

 

[Korhan Ayhan]

Selamlar,

Benim gözlemlediğim kadarıyla sorun dosya isminden kaynaklanıyor.

Sizin dosyanızdaki kodda dosya ismi GENEL isimli sayfanın B ve D sütunları birleştirilerek oluşturuluyor. Yani örneğinize göre dosya adı aşağıdaki şekilde olması gerekiyor.

27005-105 - [COLOR=red]BEGONYA[/COLOR].xls

Fakat sizin eklediğiniz örnek dosyanın adı aşağıdaki şekildedir.

27005-105 - [COLOR=red]MEHMET KOCA[/COLOR].xls

İsimler eşleşmediği için hatalı sonuç alıyorsunuz.

Dosya adı tanımlamanızı aşağıdaki şekilde değiştirirseniz hata almazsınız.

dosya2 = Target.Value & " - " & Target.Offset(0, [COLOR=red]1[/COLOR]).Value & ".xls"

 

[mehmetkoca]

Hocam Çok sağolun ; kafayı yemek üzereydim gerçekten.Teşekkür ederim.Emeğinize yüreğinize sağlık.
Saygılar.