Hazır Excel Makro (VBA) Kütüphanesi | Kopyala ve Kullan

Veri Temizleme

Gereksiz Boşlukları Temizle VBA Makrosu

Bu makro, seçili hücrelerdeki metin değerlerinin başındaki ve sonundaki boşlukları temizler ve birden fazla boşluğu tek boşluğa indirir. Kullanıcıdan temizlenecek bir alan seçmesini ister ve işlem tamamlandığında bilgilendirir.

vba
Sub GereksizBosluklariTemizle()

  Dim SeciliAlan As Range
  Dim Hucre As Range

  ' Seçili alanı bir Range nesnesine atayın.
  Set SeciliAlan = Selection

  ' Seçili alan boş mu?
  If SeciliAlan Is Nothing Then
    MsgBox "Lütfen temizlenecek bir alan seçin.", vbExclamation, "Uyarı"
    Exit Sub
  End If

  ' Seçili alandaki her hücreyi döngüye alın.
  For Each Hucre In SeciliAlan

    ' Hücre bir metin ise.
    If Hucre.HasFormula = False And VarType(Hucre.Value) = vbString Then
      ' Baştaki ve sondaki boşlukları ve birden fazla boşluğu tek boşluğa indirgeyin.
      Hucre.Value = Application.WorksheetFunction.Trim(Hucre.Value)
    End If

  Next Hucre

  ' Belleği temizle.
  Set SeciliAlan = Nothing
  Set Hucre = Nothing

  MsgBox "Seçili alandaki boşluklar temizlendi.", vbInformation, "İşlem Tamamlandı"

End Subvba
Sub GereksizBosluklariTemizle()

  Dim SeciliAlan As Range
  Dim Hucre As Range

  ' Seçili alanı bir Range nesnesine atayın.
  Set SeciliAlan = Selection

  ' Seçili alan boş mu?
  If SeciliAlan Is Nothing Then
    MsgBox string">"Lütfen temizlenecek bir alan seçin.", vbExclamation, string">"Uyarı"
    Exit Sub
  End If

  ' Seçili alandaki her hücreyi döngüye alın.
  For Each Hucre In SeciliAlan

    ' Hücre bir metin ise.
    If Hucre.HasFormula = False And VarType(Hucre.Value) = vbString Then
      ' Baştaki ve sondaki boşlukları ve birden fazla boşluğu tek boşluğa indirgeyin.
      Hucre.Value = Application.WorksheetFunction.Trim(Hucre.Value)
    End If

  Next Hucre

  ' Belleği temizle.
  Set SeciliAlan = Nothing
  Set Hucre = Nothing

  MsgBox string">"Seçili alandaki boşluklar temizlendi.", vbInformation, string">"İşlem Tamamlandı"

End Sub

Veri Temizleme

Boş Satırları Silme VBA Makrosu

Bu makro, aktif çalışma sayfasındaki kullanılan alanda bulunan boş satırları A sütununu baz alarak siler. Döngü aşağıdan yukarı doğru çalıştığı için satırlar doğru şekilde silinir ve hatalar önlenir.

vba
Sub BosSatirlariSil()
  Dim SonSatir As Long
  Dim i As Long
  Dim Alan As Range

  ' Çalışılacak alanı belirle (A sütununu baz alarak)
  Set Alan = ActiveSheet.UsedRange

  ' Son satırı bul
  SonSatir = Alan.Rows.Count

  ' Aşağıdan yukarı doğru döngü
  For i = SonSatir To 1 Step -1
    ' Satırın boş olup olmadığını kontrol et
    If WorksheetFunction.CountA(Rows(i)) = 0 Then
      ' Satırı sil
      Rows(i).Delete
    End If
  Next i

  ' Belleği temizle
  Set Alan = Nothing

  MsgBox "Boş satırlar silindi.", vbInformation
End Subvba
Sub BosSatirlariSil()
  Dim SonSatir As Long
  Dim i As Long
  Dim Alan As Range

  ' Çalışılacak alanı belirle (A sütununu baz alarak)
  Set Alan = ActiveSheet.UsedRange

  ' Son satırı bul
  SonSatir = Alan.Rows.Count

  ' Aşağıdan yukarı doğru döngü
  For i = SonSatir To 1 Step -1
    ' Satırın boş olup olmadığını kontrol et
    If WorksheetFunction.CountA(Rows(i)) = 0 Then
      ' Satırı sil
      Rows(i).Delete
    End If
  Next i

  ' Belleği temizle
  Set Alan = Nothing

  MsgBox string">"Boş satırlar silindi.", vbInformation
End Sub

Sayfa İşlemleri

Tüm Sayfa (Sekme) İsimlerini Listele (İçindekiler)

Yüzlerce sayfanız varsa, makroyu çalıştırdığınız an yeni bir "İçindekiler" sayfası açar ve tüm sayfaların ismini alt alta bir liste olarak yazar.

Sub İcindekilerOlustur()
    Dim ws As Worksheet
    Dim indexSheet As Worksheet
    Dim i As Integer
    
    ' Yeni sayfa ekle
    Set indexSheet = Sheets.Add(Before:=Sheets(1))
    indexSheet.Name = "İçindekiler Listesi"
    
    indexSheet.Cells(1, 1).Value = "SAYFA ADLARI"
    indexSheet.Cells(1, 1).Font.Bold = True
    
    i = 2
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> indexSheet.Name Then
            indexSheet.Cells(i, 1).Value = ws.Name
            i = i + 1
        End If
    Next ws
End SubSub İcindekilerOlustur()
    Dim ws As Worksheet
    Dim indexSheet As Worksheet
    Dim i As Integer
    
    ' Yeni sayfa ekle
    Set indexSheet = Sheets.Add(Before:=Sheets(1))
    indexSheet.Name = string">"İçindekiler Listesi"
    
    indexSheet.Cells(1, 1).Value = string">"SAYFA ADLARI"
    indexSheet.Cells(1, 1).Font.Bold = True
    
    i = 2
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> indexSheet.Name Then
            indexSheet.Cells(i, 1).Value = ws.Name
            i = i + 1
        End If
    Next ws
End Sub

Dosya & İndirme

Tüm Sayfaları Ayrı PDF Olarak Kaydet

Çalışma kitabındaki her bir sayfayı (Sheet), sayfanın kendi adıyla bilgisayarınızda (Masaüstü/Belgeler vs.) PDF dosyasına dönüştürür.

Sub SayfalariPDFYap()
    Dim ws As Worksheet
    Dim KlasorYolu As String
    
    ' Kaydedilecek klasör yolu (Sonunda ters slash olmalı)
    KlasorYolu = ActiveWorkbook.Path & "\" 
    
    For Each ws In ActiveWorkbook.Worksheets
        ws.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=KlasorYolu & ws.Name & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next ws
    
    MsgBox "PDF dışa aktarımı bitti!", vbInformation
End SubSub SayfalariPDFYap()
    Dim ws As Worksheet
    Dim KlasorYolu As String
    
    ' Kaydedilecek klasör yolu (Sonunda ters slash olmalı)
    KlasorYolu = ActiveWorkbook.Path & string">"\" 
    
    For Each ws In ActiveWorkbook.Worksheets
        ws.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=KlasorYolu & ws.Name & string">".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next ws
    
    MsgBox string">"PDF dışa aktarımı bitti!", vbInformation
End Sub

Veri Temizleme

Aktif Sütundaki Boş Satırları Silme

Seçili olan sütuna bakar ve eğer o hücre tamamen boşsa, tüm satırı silerek veriyi yukarı çeker. Büyük verileri temizlemek için harikadır.

Sub BosSatirlariSil()
    ' ExcelPratik.com - Sadece boş hücreleri tespit edip o satırı siler
    On Error Resume Next
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    MsgBox "Boşluklar temizlendi.", vbInformation
End SubSub BosSatirlariSil()
    ' ExcelPratik.com - Sadece boş hücreleri tespit edip o satırı siler
    On Error Resume Next
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    MsgBox string">"Boşluklar temizlendi.", vbInformation
End Sub

Sayfa İşlemleri

Tüm Sayfaları Aynı Şifreyle Kilitleme

Bu kod, çalışma kitabınızdaki mevcut tüm sayfaları tek bir seferde, belirlediğiniz bir şifre ile korumaya alır (kilitler).

Sub TumSayfalariKilitle()
    ' ExcelPratik.com - Tüm sayfaları tek tıkla şifreler
    Dim ws As Worksheet
    Dim sifre As String
    
    sifre = "12345" ' Buraya kendi şifrenizi yazın
    
    For Each ws In ActiveWorkbook.Worksheets
        ws.Protect Password:=sifre
    Next ws
    
    MsgBox "Tüm sayfalar başarıyla kilitlendi!", vbInformation, "İşlem Tamam"
End SubSub TumSayfalariKilitle()
    ' ExcelPratik.com - Tüm sayfaları tek tıkla şifreler
    Dim ws As Worksheet
    Dim sifre As String
    
    sifre = string">"12345" ' Buraya kendi şifrenizi yazın
    
    For Each ws In ActiveWorkbook.Worksheets
        ws.Protect Password:=sifre
    Next ws
    
    MsgBox string">"Tüm sayfalar başarıyla kilitlendi!", vbInformation, string">"İşlem Tamam"
End Sub

Hazır Makro (VBA) Deposu

Gereksiz Boşlukları Temizle VBA Makrosu

Boş Satırları Silme VBA Makrosu

Tüm Sayfa (Sekme) İsimlerini Listele (İçindekiler)

Tüm Sayfaları Ayrı PDF Olarak Kaydet

Aktif Sütundaki Boş Satırları Silme

Tüm Sayfaları Aynı Şifreyle Kilitleme

Sonuç Bulunamadı