38 Yararlı Excel Makro Örneği

Bu makalemizde, çalışma kitabı ve sayfalarında kullanılacak 38 Yararlı Excel Makro Örneği yararlanmanız için ekliyoruz. Makrolara başlangıç seviyesindeki bu kodları inceleyerek, ilerideki çalışmalarınız için referans alabilirsiniz.

Kes Kopyala ve Yapıştır İşlemleri isimli makalemizde (makalemizi incelemek için buraya tıklayabilirsiniz), makroların öneminden kısaca bahsetmiştik. Sizler için hazırladığımız ve fayda sağlayacağını düşündüğümüz bu hazır örneklerin ne tür bir fayda sağlayacağını anlamak için Kes Kopyala ve Yapıştır İşlemleri isimli makalemize göz atmanızı tavsiye ederiz.

Şimdi artık kodlarımızı inceleme zamanı.
Biz yine de her ihtimale karşılık, bu kodları nasıl kullanacağınızın özetini aşağıda belirtelim:



  • Visual Basic Editor’ı (Alt + F11) açın,
  • Yeni bir modül ekleyin (Ekle -> Modül)
  • Kodlar kopyalayıp modülün sağ kısmındaki beyaz bölüme yapıştırın.
Sub YeniExcelDosyasıOluştur()  
Dim wb As Workbook  
Set wb = Workbooks.Add  
wb.SaveAs ThisWorkbook.Path & "\temp.xlsx" 'bu dosyanızın kayıtlı olduğu klasöre kaydeder
End Sub


Sub ExcelDosyasınıAç()
 Dim wb As Workbook
 Dim fPath As String
 
 fPath = "C:\....\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 wb.Close
End Sub


Sub DosyayıKapat()
 Dim wb As Workbook
 Dim fPath As String
 
 fPath = "C:\....\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 
 wb.Close True 'otomatik kaydeder
 wb.Close False 'kaydetmeden kapatır
End Sub


Sub DosyayıKaydet()
 Dim wb As Workbook
 Dim fPath As String
 Dim newPath As String
 
 fPath = "C:\....\dosyam.xlsx" ' eski yol
 newPath = "D:\....\myfile1.xlsx" ' yeni yol
 Set wb = Workbooks.Open(Filename:=fPath)

 wb.Save
 wb.SaveAs Filename:=newPath
End Sub


Sub DosyayıSil()
 Dim wb As Workbook
 Dim fPath As String
 
 fPath = "C:\....\dosyam.xlsx"

 Kill PathName:=fPath
End Sub


Sub ÇalışmaKitabınaYeniSayfaEkle()
 Dim wb As Workbook
 Dim fPath As String
 
 fPath = "C:\....\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 wb.Worksheets.Add
End Sub


Sub ÇalışmaKitabınaYeniSayfaEkleYeriniBelirle()
 Dim wb As Workbook
 Dim fPath As String
 
 fPath = "C:\....\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 wb.Worksheets.Add Before:=1
 wb.Worksheets.Add After:=1
 wb.Worksheets.Add After:=Worksheets.count
End Sub


Sub SayfaAdınıDeğiştir()
 Dim wb As Workbook
 Dim sh As Worksheet
 
 Dim newSheetName As String
 newSheetName = "March"
 
 Dim fPath As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Name = newSheetName
End Sub


Sub SayfayıSilme()
 Dim wb As Workbook
 Dim sh As Worksheet
 
 Dim newSheetName As String
 newSheetName = "March"
 
 Dim fPath As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 Application.DisplayAlerts = False
 sh.Delete
 Application.DisplayAlerts = True
End Sub


Sub SayfanınRenkKodunuDeğiştirme()

 Dim wb As Workbook
 Dim sh As Worksheet
 
 Dim newSheetName As String
 newSheetName = "March"
 
 Dim fPath As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Tab.ColorIndex = 1
 sh.Tab.Color = RGB(255, 0, 300)
 End Sub


Sub SayfayıKopyalama()

 Dim wb As Workbook
 Dim sh As Worksheet
 
 Dim newSheetName As String
 newSheetName = "ExcelDepo"
 
 Dim fPath As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Copy
End Sub


Sub SayfayıYeniKitabaKopyalama()

 Dim wb As Workbook
 Dim sh As Worksheet
 
 Dim newSheetName As String
 newSheetName = "March"
 
 Dim fPath As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 wb.Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Copy
End Sub


Sub İstediğinAdlaSayfayıKopyalama()

 Dim wb As Workbook
 Dim sh As Worksheet
 
 Dim newSheetName As String
 newSheetName = "March"
 
 Dim fPath As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Copy Before:=Sheets(1)
 ActiveSheet.Name = "Sayfan"
End Sub


Sub SayfaGizleme()

 Dim wb As Workbook
 Dim sh As Worksheet
 
 Dim newSheetName As String
 newSheetName = "March"
 
 Dim fPath As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 '
 Set sh = wb.Worksheets(1)
 sh.Visible = xlSheetHidden
End Sub


Sub TümSayfalarıGizleme()
 Dim wb As Workbook
 Dim fPath As String
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 For Each Sheet In wb.Worksheets
 If Sheet.Name <> ActiveSheet.Name Then
 Sheet.Visible = False
 End If
 Next
End Sub


Sub TümSayfalarıGösterme()
 Dim wb As Workbook
 Dim fPath As String
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 For Each Sheet In wb.Worksheets
 If Sheet.Name <> ActiveSheet.Name Then
 Sheet.Visible = True
 End If
 Next
End Sub


Sub SayfaVarmıKontrolü()
 Dim wb As Workbook
 Dim fPath As String
 Dim sheetExists As Boolean
 sheetExists = False
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 For Each Sheet In wb.Worksheets
 If Sheet.Name = "Aranacak Sayfa Adı" Then
 sheetExists = True
 Exit For
 End If
 Next
 
 If sheetExists Then
 MsgBox "Yes, SheetName To Search exists in the workbook"
 End If
 
End Sub


Sub SayfalarıAlfabetikSıralama()
 Dim i As Integer
 Dim j As Integer
 Dim totalSheets As Integer
 totalSheets = Sheets.count
 For i = 1 To totalSheets - 1
 For j = i + 1 To totalSheets
 If Sheets(j).Name < Sheets(i).Name Then
 Sheets(j).Move Before:=Sheets(i)
 End If
 Next j
 Next i
 Application.ScreenUpdating = True
End Sub


Sub SayfayaSatırEkleme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Rows(4).Insert
 sh.Rows("3:5").EntireRow.Insert
 
 ActiveCell.Rows.Insert
End Sub


Sub SayfayaSütunEkleme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Columns(B).Insert
 
 sh.Columns("A:C").Insert
End Sub


Sub SayfadanSatırSilme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Rows(2).Delete
 
 sh.Rows("3:5").Delete
End Sub


Sub SayfadanSütunSilme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Columns(B).Delete
 
 sh.Columns("A:C").Delete
End Sub


Sub SayfadaSatırGizleme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Rows(2).Hidden = True
 
 sh.Rows("3:5").Hidden = True
End Sub


Sub SayfadaSütunGizleme()

 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Columns("C").Hidden = True
 
 sh.Columns("A:C").Hidden = True
End Sub


Sub SayfadakiSatırlarıGösterme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Rows(2).Hidden = False
 
 sh.Rows("3:5").Hidden = False
 
End Sub


Sub SayfadakiSütunlarıGösterme()

 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Columns("C").Hidden = False
 
 sh.Columns("A:C").Hidden = False
End Sub


Sub KopyalaVeSatırOlarakEkle()

 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Rows(2).EntireRow.Copy
 sh.Rows(10).Insert
 
 sh.Rows("2:5").EntireRow.Copy
 sh.Rows(10).Insert
End Sub


Sub KopyalaVeSütunOlarakEkle()

 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Columns("A").EntireColumn.Copy
 sh.Columns("D").Insert
 
 sh.Columns("A:D").EntireColumn.Copy
 sh.Columns("F").Insert
End Sub


Sub SayfayıParolasızKoruma()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Protect
End Sub


Sub SayfayıParolaİleKoruma()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Protect Password:="parola123"
End Sub


Sub ParolasızSayfanınParolasınıAçma()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Unprotect
End Sub


Sub ParolalıSayfanınParolasınıAçma()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Unprotect Password:="parola123"
End Sub


Sub DosyayıParolasızKoruma()
 Dim wb As Workbook
 Dim fPath As String
 Dim newFileName As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 newFileName = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 
 wb.SaveAs Filename:=newFileName, Password:="parola123"
End Sub


Sub DosyayıParolaİleKoruma()
 Dim wb As Workbook
 Dim fPath As String
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath, Password:="parola123")
End Sub


Sub BiçimlereDokunmadanBirAralığıTemizleme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)

 sh.Range("A1:X5").ClearContents
End Sub


Sub BiçimleriVeİçeriğiTemizleme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Range("A1:P27").Clear
End Sub


Sub ÇalışmaSayfasınınİçeriğiniTemizleme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.UsedRange.Clear
 
 sh.UsedRange.ClearContents
End Sub


Sub TümAçıklamalarıTemizleme()
 Dim wb As Workbook
 Dim fPath As String
 Dim sh As Worksheet
 
 fPath = "C:\Users\exceldepo\Desktop\dosyam.xlsx"
 Set wb = Workbooks.Open(Filename:=fPath)
 Set sh = wb.Worksheets(1)
 sh.Range("A1:P27").ClearComments
End Sub


38 Yararlı Excel Makro Örneği - Excel Özellikleri:

RunAutoMacros

Etiketler

Excel Eğitimleri
Üstteki alanda, Google Reklamları yerine sizin reklamınızın yayınlanmasını ister misiniz?
Reklam vermek istiyorum

Daha önce yorum yapılmamış!

Makale Arşivi
Klavyeyi kullanarak hızlı bir şekilde tablolarınıza satır eklemek için, satır eklemek istediğiniz hücreye gelip sırayla Alt, E ve S tuşlarına basmanız yeterli olacaktır.

Birden fazla satır eklemek isterseniz, aralıksız olarak seçim için Shit, aralıklı olarak seçin için Ctrl tuşları ile, aralara ekleme yapılacak satırları seçtikten sonra yine, sırayla Alt, E ve S tuşlarına basmanız yeterli olacaktır.

Benzer şekillerde sütun eklemek için sırayla Alt, E ve T tuşlarına basmanız yeterli olacaktır.

Bu kısayollar Türkçe Excel kullanıcıları için geçerlidir.
Yükleniyor...