- 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?
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
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?
