• DİKKAT

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

Sayfa İsimlerini Kontrol ederek İşlem Yapmak

  • Konbuyu başlatan Konbuyu başlatan htsumer
  • Başlangıç tarihi Başlangıç tarihi

htsumer

Altın Üye
Altın Üye
Katılım
7 Eylül 2004
Mesajlar
975
Excel Vers. ve Dili
Excel-2003
"7_Kurum_BankaListesi" ve "Maaş_Giriş_Sayfası" isminde 2 sayfam var.
Bir butona bağladığım kodlardan önce, bu iki sayfanın olup olmadığını kontrol edecek ve olması halinde " 7_Kurum_BankaListesi ve Maaş_Giriş_Sayfası adlı sayfalarınız bulunmakta olup, silinecektir" ikazı çıkacak ve EVET denildiğinde o sayfaları silecek ve devamındaki kodlar çalışacak, hayır denildiğinde işlemi sonlandıracak koda ihtiyacım var.
Teşekkürler.
 
Sanıyorum aşağıdaki şekilde olur, tüm sayfaları n adını ayrı ayrı kontrol eder ve varsa uyarı verir:

Kod:
sub kontrol()

for i = 1 to sheets.count
       if sheets(i).name = "7_Kurum_BankaListesi" or sheets(i).name = "Maaş_Giriş_Sayfası" then
              uyarı = msgbox(sheets(i).name & " adlı sayfanız bulunmakta olup silinecektir!", vbyesno)
              if uyarı = vbyes then
                     sheets(i).delete
              end if
       end if
next

'diğer kodlar

end sub
 
Teşekkür ederim. Fakat Verdiğiniz kodu entegre ettim
Kod:
Dim i As Byte, nWB As Byte, nSh As Byte

Satırı hata verdi.


Kod:
Sub MergeWBooks1()
'sayfa kontrol başı
For i = 1 To Sheets.Count
       If Sheets(i).Name = "7_Kurum_BankaListesi" Or Sheets(i).Name = "Maaş_Giriş_Sayfası" Then
              uyarı = MsgBox(Sheets(i).Name & " adlı sayfanız bulunmakta olup silinecektir!", vbYesNo)
              If uyarı = vbYes Then
                     Sheets(i).Delete
              End If
       End If
Next
'diğer kodlar
'sayfa kontrol bitiş
Sayfa_Adı = ActiveSheet.Name
Dim MyTitle As String, MyPath As String, MyFile As String
Dim i As Byte, nWB As Byte, nSh As Byte
Dim ObjFolder As Object
MyTitle = "Lütfen sayfaları birleştirilecek dosyaların olduğu yolu seçin !"
Set ObjFolder = CreateObject("Shell.Application").browseforfolder(0, MyTitle, 0, 0)
If Not ObjFolder Is Nothing Then
MyPath = ObjFolder.Items.Item.Path
MyFile = Dir(MyPath & Application.PathSeparator & "*.xls", vbDirectory)
Application.ScreenUpdating = False
Do While MyFile <> ""
If MyFile = ThisWorkbook.Name Then GoTo ResumeSub:
nWB = nWB + 1
Workbooks.Open MyPath & Application.PathSeparator & MyFile
Dim myArray() As Variant
For i = 1 To ActiveWorkbook.Sheets.Count
ReDim Preserve myArray(i - 1)
myArray(i - 1) = i
nSh = nSh + 1
Next i
Sheets(myArray).Select
Sheets(myArray).Copy Before:=ThisWorkbook.Sheets(1)
Workbooks(MyFile).Close
ResumeSub:
MyFile = Dir
Loop
Set ObjFolder = Nothing
Sheets(Sayfa_Adı).Select
MsgBox "Toplam " & nWB & " adet kitaptan toplam " & nSh & " adet sayfa birleştirilmiştir !", vbInformation, "Rapor !"
End If
Application.ScreenUpdating = True
End Sub
 
Tamam halloldu yanlış yere almışım kodları. Teşekkür ederim.
 
Geri
Üst