38 Yararlı Excel Makro Örneği

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