38 Yararlı Excel Makro Örneği

38 Yararlı Excel Makro Örneği

  • Konuyu başlatan Konuyu başlatan ExcelDepo
  • Başlangıç tarihi Başlangıç tarihi
Bu makalemizde, çalışma kitabı ve sayfalarında kullanılacak 38 hazır kod örneğini ekliyoruz. Makrolara başlangıç seviyesindeki bu kodları inceleyerek, ilerikideki çalışmalarınız için referans alabilirsiniz. Yararlı olması temennisiyle.

Kod:
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

Kod:
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
Kod:
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
Kod:
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
Kod:
Sub DosyayıSil()
Dim wb As Workbook
Dim fPath As String

fPath = "C:\....\dosyam.xlsx"

Kill PathName:=fPath
End Sub
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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
Kod:
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.
 
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst