Soru kod içerisinde referans hücre hatalı ise işlemi tamamlasın

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Kod:
.
.
......
End If
Dosyam = ThisWorkbook.Path & "\BİRLEŞTİRMELER\FORM-BÖLGE.xlsx"
If Dir(Dosyam) <> "" Then
    Kill Dosyam
End If
Set w1 = Workbooks.Add
w1.SaveAs Filename:=Dosyam, FileFormat:=xlOpenXMLWorkbook
Path = ThisWorkbook.Path & "\SERVİSLER\FORM\Bölge \"
Filename = Dir(Path & "*.xlsx")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     ActiveSheet.Name = Replace(Replace(Replace(Replace(Replace(Left(ActiveSheet.Range("w2"), 31), ":", "-"), "/", "-"), "(", ""), ")", ""), "*", "-")
    Sheet.Copy After:=w1.Sheets(1)
      Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
  Loop
 Call SortSheetsTabName
    w1.Save 'Dosyayı kaydeder
w1.Close 'Dosyayı kapatır
bekle = ""
MsgBox "Birleştirme Tamamlandı", vbInformation
End Sub
koddaki W2 hücresinden alınan değer formülle geliyor ve eğer formül sonucu #YOK verirse işlem kesiliyor. #YOK yazan sonuç olduğunda atlaması ve işlemi tamamlaması için nereye ne eklemeliyim acaba. yardımcı olabilecek arkadaşlara şimdiden teşekkürler...
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,743
Excel Vers. ve Dili
2021 Türkçe
Merhaba.
W2 hücresinde #YOK yazdığını hangi satırda kontrol etmek istiyorsanız aşağıdaki kodu oraya kopyalayın
Kod:
If IsError(Range("W2")) Then GoTo 1
Eğer W2 de #Yok yazıyorsa hangi hücreden devam etmesini istiyorsanız o satıra da
1:
yazın.

Aşağıdaki gibi

Kod:
.
.
......
End If
Dosyam = ThisWorkbook.Path & "\BİRLEŞTİRMELER\FORM-BÖLGE.xlsx"
If Dir(Dosyam) <> "" Then
    Kill Dosyam
End If
Set w1 = Workbooks.Add
w1.SaveAs Filename:=Dosyam, FileFormat:=xlOpenXMLWorkbook
Path = ThisWorkbook.Path & "\SERVİSLER\FORM\Bölge \"
Filename = Dir(Path & "*.xlsx")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     If IsError(Range("W2")) Then GoTo 1
     ActiveSheet.Name = Replace(Replace(Replace(Replace(Replace(Left(ActiveSheet.Range("w2"), 31), ":", "-"), "/", "-"), "(", ""), ")", ""), "*", "-")
    Sheet.Copy After:=w1.Sheets(1)
      Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
  Loop
Call SortSheetsTabName
    w1.Save 'Dosyayı kaydeder
w1.Close 'Dosyayı kapatır
bekle = ""
MsgBox "Birleştirme Tamamlandı", vbInformation
1:
End Sub
 
Üst