Silme Kodlarına İlave Sayfalarda Silinecek Alan ekleme

[vurkan]

Arkadaşlar Merhaba
Aşağıdaki kodlarla belli sayfalar dışında kalan sayfaları komple, KULÜPLER sayfasında ise belli aralıkları siliyorum. Kodlar gayet güzel çalışıyor. Bu kodlara yapılacak ilaveyle:
1- LİSTE sayfasından A:N aralığındaki tüm veileri,
2- SINIF Sayfasındaki G:S aralığındaki tüm verileri
3- BORDRO sayfasındaki:
a) E23:F44 aralığını,
b) F45 hücresini,
c) E46:F50 aralığını kapsayan verileri silmek istiyorum. Yani yapmak istediğim sene başında bu kod çalışınca dosyada değişecek tüm alanlar temizlensin. Saygılar.

Sayfa koruma şifrelerini açmıştım ama yine de lazım olursa "sivas"

http://s3.dosya.tc/server17/jtv1s8/2018_KULUP_V1.rar.html

Kullandığım ve bu kodların ekleneceği kodlar:
(Bu kodlar SENEBAŞI GEÇMİŞİ SİLELİM dümesine atanmıştır)

Sub fsil()
uyarı = MsgBox("B3:C55 arasındaki KULÜP ve ÖĞRETMEN adları silenecek, emin misiniz?", vbYesNo)
If uyarı = vbYes Then
Application.EnableEvents = False
[b3:c55].ClearContents
Application.EnableEvents = True
End If
On Error Resume Next
Application.DisplayAlerts = False
döngü:
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "LİSTE" Then GoTo pass 'yazılan sayfa pas geçiliyor
If Worksheets(i).Name = "SINIF" Then GoTo pass 'yazılan sayfa pas geçiliyor
If Worksheets(i).Name = "OKUL" Then GoTo pass 'yazılan sayfa pas geçiliyor
If Worksheets(i).Name = "ŞABLON" Then GoTo pass 'yazılan sayfa pas geçiliyor
If Worksheets(i).Name = "KULÜPLER" Then GoTo pass 'yazılan sayfa pas geçiliyor
If Worksheets(i).Name = "BORDRO" Then GoTo pass 'yazılan sayfa pas geçiliyor
If Worksheets(i).Name = "BANKA LİSTESİ" Then GoTo pass 'yazılan sayfa pas geçiliyor
If Worksheets(i).Name = "GİRİŞ" Then GoTo pass 'yazılan sayfa pas geçiliyor

Worksheets(i).Delete
GoTo döngü:
pass:
Next i
End Sub

 

[turist]

Sayın @vurkan
Dosyanız aşağıdaki linktedir.
Olası hataları engellemek amacıyla, silme işlemini çalıştırmadanönce dosyanızın bir yedeğini alınız.

Dosyanızın Linki

 

[vurkan]

Üstadım Çok teşekkür ediyorum. Elinize sağlık. Verdiğiniz kodlardan;

Sheets("LİSTE").[A1:N65500].ClearContents

Sheets("SINIF").[G1:S65500].ClearContents

Sheets("OKUL").[A265500].ClearContents

Sheets("BORDRO").[E23:F44,F45,E46:F50].ClearContents

Kısmını bendeki kodlarla birleştirerek istediğim sonucu elde ettim. Teşekkür ediyorum. İlave olarak bir istirhamım daha olsa. Şöyle ki;

Bu kodlarla sildiğimiz LİSTE ve SINIF sayfaları e-okuldan excele aktardığımız ve ekte sunduğum dosya formatında olan dosyalardan alabilir miyiz?

Bu dosyaları excele aktarırken örneğin LİSTE sayfasının verilerini kapsayan dosya OKUL, SINIF sayfasının verileri de SINIF isimli dosyalarda olsa;

Bir düğmeye atayacağımız kodlarla;

• “OKUL” isimli dosyadaki A:N aralığını LİSTE sayfasındaki A:N aralığına,
• “SINIF” isimli dosyadaki A:K aralığını SINIF sayfasında ki G:S aralığına olduğu gibi alabilir miyiz? (Kopyala yapıştır gibi.) Bu dosyalar aynı klasör ve ya masa üstünde olabilirler. Teşekkür ederim.

http://s3.dosya.tc/server17/cb3y7i/Yeni_klasor__2_.rar.html

 

[turist]

Sayın @vurkan
Dosyanızın Linki

3 dosyanın aynı klasörde veya masaüstünde olmasına dikkat ediniz.

 

[vurkan]

Üstadım bu link hasar görmüş olabilir mi? Dosyaya ulaşamıyorum. Başka bir yerden paylaşsanız. Saygılar.

 

[turist]

Dosyaupload.com sitesinde sorun var.(Dosyada hasar yok)

Bir başka sitedeki Dosyanızın Linki

 

[vurkan]

Üstadım Çok teşekkür ediyorum. Ellerine Sağlık.
Bütün bu çalışmalarım için e okuldan bilgileri excele aktarmayı anlatan bir yardım sayfası hazırlıyorum. Geçen bir tane hazırladım. Arkadaşlarda denedim. olmadı. Bu yüzden bana bağımlı kalıyorlar.
İnternetten bu dosyaları alanların kendi başlarına rahatça kullanmalarını istiyorum. Bunun için yeni bir tane yardım dosyası hazırlayacağım. Böylece bana ihtiyaçları kalmadan bu dosyaları rahat rahat kullanabilecekler. Eğer bunu başaramazsam bunu yapmak için e okuldan istenilen formatta veri alabilecek bir çalışma yapma peşine düşeceğim. İnşallah buna gerek kalmaz.
Saygılarımla.

 

[turist]

Sağ olun, kolay gelsin.

 

[vurkan]

Arkadaşlar merhaba. Sayın turist üstadımın 2018 KULÜP V2 dosyam için yazdığı kodlar dosya adı değiştirilince

Windows("2018 KULÜP V2.xlsm").Activate:

satırında hata veriyor. Burada dosya adı değişse de kodun çalışması için nasıl bir değişiklik gerekir. Saygılar.

Kullanılan kod:
Sub LISTE_OKUL_AL()
ActiveSheet.Unprotect "sivas"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
YOL = ThisWorkbook.Path
Dim okul As String
okul = "OKUL LİSTE.xls"
klasor1 = YOL & "\" & okul

Workbooks.Open Filename:=klasor1
Columns("A:N").Copy
ActiveSheet.Unprotect "sivas"
Windows("2018 KULÜP V2.xlsm").Activate: Sheets("LİSTE").Select: Range("A1").Select: ActiveSheet.Paste
Windows("OKUL LİSTE.xls").Activate: ActiveWindow.Close
Sheets("KULÜPLER").Select
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveSheet.Protect "sivas"
End Sub

 

[turist]

Sayın @vurkan ,
Değişen dosya adını,
Windows("2018 KULÜP V2.xlsm").Activate:
"kırmızı" renkli harflerle yazılı kısma yazın.
(Windows("YeniDosya.xlsm").Activate: gibi)

 

[vurkan]

Üstadım ben elbette yazarım. Ama dosyalarımı kullanacak arkadaşlar bu ayrımı bilemezler diye düşünmüştüm. İlgi ve cevabınıza teşekkür ediyorum. Sağ olun.

 

[turist]

Sub LISTE_OKUL_AL()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
YOL = ThisWorkbook.Path
Dim okul As String
okul = "OKUL LİSTE.xls"
klasor1 = YOL & "\" & okul
budosya = ThisWorkbook.Name
busayfa = ActiveSheet.Name
    Workbooks.Open Filename:=klasor1
    Columns("A:N").Copy
    Windows(budosya).Activate: Sheets("LİSTE").Select: Range("A1").Select: ActiveSheet.Paste
    Windows("OKUL LİSTE.xls").Activate: ActiveWindow.Close
    Sheets(busayfa).Select
   Application.DisplayAlerts = False
Application.ScreenUpdating = False
End Sub
Sub LISTE_SINIF_AL()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
YOL = ThisWorkbook.Path
Dim sinif As String
sinif = "SINIF LİSTE.xls"
klasor2 = YOL & "\" & sinif
budosya = ThisWorkbook.Name
busayfa = ActiveSheet.Name
    Workbooks.Open Filename:=klasor2
    Columns("A:K").Copy
    Windows(budosya).Activate: Sheets("SINIF").Select: Range("G1").Select: ActiveSheet.Paste
    Windows("SINIF LİSTE.xls").Activate: ActiveWindow.Close
    Sheets(busayfa).Select
  Application.DisplayAlerts = False
Application.ScreenUpdating = False
End Sub

şeklinde uygulayın.

 

[vurkan]

Teşekkür ediyorum sağ olun.

 

[turist]

Siz de sağ olun.