• DİKKAT

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

bağlantı güncelleştir hatası

Katılım
29 Kasım 2008
Mesajlar
215
Excel Vers. ve Dili
excel 2003 türkçe
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo son
If Intersect(Target, [b5:b95]) Is Nothing Then Exit Sub
dosya1 = ThisWorkbook.Name
dosya2 = Target.Value & " - " & Target.Offset(0, 2).Value & ".xls"
Set s1 = Sheets("KAPAK")
Set s2 = Sheets("BİLDİRİM RAPORU")

Application.ScreenUpdating = False
Dosya_Yolu = "C:\Users\mehmet\Desktop\ONAYLANANLAR" & "\" & dosya2
'Dosya_Yolu = "C:\Deneme" & "\" & 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


Arkadaşlar burdaki makroyu çalıştırdığımda göndermiş olduğum resimdeki hata ile karşılaşıyorum.ve ancak devama tıklarsam aktarma gerçekleşiyor.bunun bir çözümü varmıdır acaba?
 

Ekli dosyalar

  • hata.jpg
    hata.jpg
    37.2 KB · Görüntüleme: 10
merhaba

bunu deneyiniz
Application.DisplayAlerts = False
 
Teşekkürler.Hata giderildi.
 
Geri
Üst