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.