25 Şubat 2019 26 Aralık 2020 1197

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
Örnek kodların yer aldığı dosyayı BURADAN indirebilirsiniz.

Kullanılan Excel Özellikleri:

Makale Serileri

Makale Arşivi
Backlink Reklam Bu alanda 50 karakterlik açıklama ile web sitenize ait Backlink Reklam yayınlayabilirsiniz.
Yükleniyor...