Subscrib Out of Range hatası!!!

[baykan_m]

Merhaba arkadaşlar,

Aşağıda bulunan kodda Windows("ÜRÜNLER.xlsm").Activate kısmına geldiğinde Subscribe Out Of Range hatası veriyor. Dosya ismi doğru herşey doğru ama ben çözemedim. Nerede hata yapıyorum arkadaşlar?

Private Sub Workbook_Open()

Cariler = ActiveWorkbook.Path & "\Cariler.xlsm"
Urunler = ActiveWorkbook.Path & "\Ürünler.xlsm"

Sheets("Cariler").Select
Application.Goto Reference:="R5C6:R5000C6"
Selection.Copy
Sheets("SABİTLER").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Open Urunler
Application.Goto Reference:="R5C6:R5000C6"
Application.CutCopyMode = False
Selection.Copy
Windows("CARİLER.xlsm").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
Windows("ÜRÜNLER.xlsm").Activate
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=-33
Range("F2:I2").Select
ActiveWindow.Close
Sheets("CARİLER").Select
ActiveWindow.SmallScroll Down:=-39
Range("F2:Q2").Select
End Sub

 

[PLİNT]

Merhaba
Dosya açık değilsede o hatayı verebilir,
kodlarınızın hata veren o aralığına; aşağıdaki kırmızı bölümü ekleyip deneyiniz.

'....
'.....kodlarınız
'....
Range("B2").Select
[COLOR="Red"]For Each a In Application.Workbooks
If a.Name = "Ürünler.xlsm" Then x = 1
Next
If x = Empty Then Workbooks.Open ActiveWorkbook.Path & "\Ürünler.xlsm"[/COLOR]
Windows("ÜRÜNLER.xlsm").Activate
Application.CutCopyMode = False
'....
'...
'..

 

[baykan_m]

Çok teşekkür ederim Plint. Ancak yine Windows("ÜRÜNLER.xlsm").Activate kısmına geldiğinde aynı hatayı alıyorum. Dosya açık. Yol doğru, isim doğru anlamadım bir türlü.

 

[baykan_m]

Problemi çözdüm. Plint sizin yazdığınız koddan sonra gelen Windows("ÜRÜNLER.xlsm").Activate kısmını sildim problem çözüldü kod doğru çalışıyor şimdi. Çok teşekkür ederim.