Makro Kod Listesi

Excel de kullanılan Makro Kodlarının Listesi

ID : 1711
ISLEM : satırı diğer sayfaya kopyalama
MAKRO KODU : Sub CopyRow() Worksheets("Sheet1").Rows(1).Copy Worksheets("Sheet2").Select Worksheets("Sheet2").Rows(1).Select Worksheets("Sheet2").Paste End Sub

ID : 1712
ISLEM : satir ekle, kopyala,sirala,alt toplamlarini al.
MAKRO KODU : Sub aralama() Range("A2:C10").Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Dim deger As Variant Dim deger1 As Variant baş: deg = 0 deger = ActiveCell.Value döngü: ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate deger1 = ActiveCell.Value satirno = ActiveCell.Row deg = Cells(satirno - 1, 3).Value + deg If deger <> deger1 Then ActiveCell.EntireRow.Insert Range("A1:C1").Copy ActiveCell.PasteSpecial Cells(satirno - 1, 4) = "TOPLAM:" Cells(satirno - 1, 5) = deg ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate GoTo baş End If değer = değer1 If deger1 = "" Then Range(Cells(satirno - 2, 1), Cells(satirno - 2, 3)).Delete GoTo 10 End If GoTo döngü 10 End Sub

ID : 1713
ISLEM : satir eklendiğinde m-n ve o sütünundaki hücre değişmesin
MAKRO KODU : Sub Kopyala() Range("N2:P2").Select Selection.Copy Range("N3:P19").Select ActiveSheet.Paste Application.CutCopyMode = False End Sub

ID : 1714
ISLEM : satir silme
MAKRO KODU : Sub SATIRSİL() Dim x, i For i = 1 To 5 '* For x = 2 To [D65526].End(3).Row Step 1 If Cells(x, 4) Like "*de*" Then Rows(x).Delete End If Next x Next i End Sub

ID : 1715
ISLEM : satir sütun başliklarini etkisiz yapar
MAKRO KODU : Private Sub Workbook_Open() Sheets("veri").ScrollArea = "a1:a10" End Sub

ID : 1716
ISLEM : satir sütun gizleme
MAKRO KODU : Boş olan Satırları Gizle Sub satirgizle() Dim i As Integer For i = 1 To 15 If Sheets("Sayfa1").Cells(i, 1).Value <> "" Then Rows(i).Hidden = False Else Sheets("Sayfa1").Rows(i).Hidden = True End If Next i End Sub 'A Sütunundaki Boş Satırları Gizler Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim i As Integer For i = 1 To 300 '1 satır ile 300. satır arası If IsEmpty(Cells(i, 1)) Then '1. Satır 1. Sütun yani A1 hücresi Rows(i).Hidden = True End If Next i Application.ScreenUpdating = True End Sub 'C Sütunundaki Boş Satırları Gizler Sub bidahabossatgizle() For i = 6 To 160 If Range("c" & i) = "" Then _ Range("c" & i).EntireRow.Hidden = True Next 'Boş olan Sütunlar Gizle Sub satirgizle() Dim i As Integer For i = 1 To 15 If Sheets("Sayfa1").Cells(i, 1).Value <> "" Then Rows(i).Hidden = False Else Sheets("Sayfa1").Rows(i).Hidden = True End If Next i End Sub 'Toplamları Sıfıra eşit olan satırları gizler Sub sıfırgizle() For Each rngRow In ActiveSheet.UsedRange.Rows If Application.Sum(rngRow) = 0 Then rngRow.EntireRow.Hidden = True End If Next rngRow End Sub

ID : 1717
ISLEM : satirdan sütuna dönüştürme
MAKRO KODU : Sub Test() Range("A1:A10") = Application.Transpose(Range("B1:K1")) End Sub

ID : 1718
ISLEM : satiri temizleme
MAKRO KODU : Sub TEMİZLE() ARALIK = "A" & ActiveCell.Row & ":D" & ActiveCell.Row Range(ARALIK).ClearContents End Sub

ID : 1719
ISLEM : satirlari artan siralamaya almak
MAKRO KODU : Sub Macro1() Range("A1:E32").Select Selection.Sort Key1:=Range("A1") End Sub

ID : 1720
ISLEM : satirlari seçmek
MAKRO KODU : Sheets("deneme").Activate For sss = 2 To Cells(65536, "a").End(3).Row If Cells(sss, 1) = "" Then Rows(Cells(sss, "a").Row).Group Next sss

ID : 1721
ISLEM : satirlari sütunlara listelemek
MAKRO KODU : Sub listele() sut = Sheets("Sayfa1").Range("A1").End(xlToRight).Column sat = Sheets("Sayfa1").Range("A1").End(xlDown).Row yazsat = 1: yazsut = 1 For i = 2 To sat For y = 1 To sut Sheets("Sayfa2").Cells(yazsat, yazsut) = Sheets("Sayfa1").Cells(i, y) yazsat = yazsat + 1 Next y yazsut = yazsut + 2 If yazsut > 5 Then yazsut = 1 yazsat = yazsat + 1 Else: yazsat = yazsat - 4 End If Next i End Sub

ID : 1722
ISLEM : save as
MAKRO KODU : Sub saveas() dosya = "IS " & Range("A1") & " " & Range("B1") dosya = WorksheetFunction.Substitute(dosya, "/", ".") ' / ları nokta yapsın. ChDrive "D" ChDir "D:\STOK" ActiveWorkbook.saveas Filename:=dosya End Sub

ID : 1723
ISLEM : save as makrosu sadece belirtilen sayfayi kaydetsin
MAKRO KODU : Sub yenisayfayedekle() Dim i As String If ActiveSheet.Range("a1").Value <> "" Then i = ActiveSheet.Range("a1").Value ActiveSheet.Select ActiveSheet.Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:= _ "C:\yedek1\" & i & ".xls", FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False Workbooks(i & ".xls").Activate ActiveWorkbook.Close ThisWorkbook.Close Application.DisplayAlerts = True Else: Exit Sub End If End Sub

ID : 1724
ISLEM : save as(farkli kaydet)
MAKRO KODU : Yeni dosyayı kapatmamız lazım Sub Makro1() Application.DisplayAlerts = False 'dosyanın üzerine yazayımmı diye sormamasını direk üstüne kaydetmesini sağlar ad = [a1] Sheets("Sayfa1").Copy ' sayfanın yeni bir workbook''a kopyasını alır ActiveWorkbook.SaveAs Filename:="C:\Documents And Settings\ersin\Belgelerim\" & ad Workbooks(ad).Close 'yeni oluşturulan dosyayı kapatır End Sub

ID : 1725
ISLEM : sayfa 1 a1 den itibaren sayfaların listesi
MAKRO KODU : Sub sahife_list() Dim pir As Worksheet Dim i As Integer For Each pir In Worksheets Range("A1").Offset(i) = pir.Name i = i + 1 Next End Sub

ID : 1726
ISLEM : sayfa 1 hariç tüm sayfaları gizle
MAKRO KODU : 1.Sayfa hariç tüm sayfaları gizle Sub xlVeryHidden_All_Sheets() On Error Resume Next Dim sh As Worksheet For Each sh In Worksheets sh.Visible = xlVeryHidden Next End Sub

ID : 1727
ISLEM : sayfa 1'den 2'ye kaydetme, boşlukları doldurarak
MAKRO KODU : Private Sub Kaydet() Dim Sh1 As Worksheet, Sh2 As Worksheet Dim Dolusay1, Dolusay2 Set Sh1 = Worksheets("Sayfa1") Set Sh2 = Worksheets("Sayfa2") Dolusay1 = WorksheetFunction.CountA(Sh1.Range("A:A")) Dolusay2 = WorksheetFunction.CountA(Sh2.Range("A:A")) Sh1.Range("A1:A" & Dolusay1).EntireRow.Copy Sh2.Range("A" & Dolusay2 + 1) End Sub

ID : 1728
ISLEM : sayfa 2 deki isimlerin karşisina değeri yazma
MAKRO KODU : Sub çizelge() Dim Tarih Dim isim As String Dim Son As Integer Dim satir, sutun, i Dim tarihalani As Range, isimalani As Range, tarih1 As Range, isim1 As Range On Error Resume Next Son = Sheets("sayfa2").Range("a65536").End(xlUp).Row Set tarihalani = Sheets("sayfa2").Range("c1:ag1") Set isimalani = Sheets("sayfa2").Range("a3:a" & Son + 15) Tarih = Sheets("sayfa1").Range("A1").Value For i = 13 To Sheets("sayfa1").Range("b65536").End(xlUp).Row isim = Sheets("sayfa1").Range("B" & i).Value Set tarih1 = tarihalani.Find(Tarih, lookat:=xlWhole) Set isim1 = isimalani.Find(isim) If tarih1 Is Nothing Then MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu." Exit Sub Else sutun = tarih1.Column satir = isim1.Row Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4) End If Next i End Sub

ID : 1729
ISLEM : sayfa adini değiştirme
MAKRO KODU : Sayfa Adını verir Sub SayfaAdı() ActiveSheet.name=Range("a1").value End Sub 'A1 Hücresine Sayfa ismini verir Sub Hücreadı() Range("a1").value=ActiveSheet.name End Sub

ID : 1730
ISLEM : sayfa adini yazdirma
MAKRO KODU : Sub Test2() If Not Sheets("Sayfa1").Range("A1") = Empty Then For i = 1 To Worksheets.Count If Sheets(i).Name = Sheets("Sayfa1").Range("A1") Then MsgBox "Bu isimli bir sayfa mevcut..... !" Exit Sub End If Next Set NewSh = Worksheets.Add(After:=Sheets(Sheets.Count)) NewSh.Name = Sheets("Sayfa1").Range("A1") End If Set NewSh = Nothing End Sub

ID : 1731
ISLEM : sayfa adlarını listeleme
MAKRO KODU : Private Sub ListBox1_Click() If ListBox1.ListIndex = -1 Then CommandButton1.Enabled = False Else CommandButton1.Enabled = True End If Label1.Caption = UCase(ListBox1.Value) End Sub ' Private Sub UserForm_Initialize() Dim i As Integer Dim j As Integer Label1.Caption = "" If Worksheets.Count = 1 Then Exit Sub For i = 1 To Worksheets.Count Sheets(i).Name = LCase(Sheets(i).Name) For j = i + 1 To Worksheets.Count If LCase(Worksheets(j).Name) < LCase(Worksheets(i).Name) Then Worksheets(j).Move Before:=Worksheets(i) End If Next j Next i For i = 1 To Sheets.Count ListBox1.AddItem Sheets(i).Name Next Sheets("ana sayfa").Move Before:=Sheets(1) End Sub

ID : 1732
ISLEM : sayfa adlarını listeleme 2
MAKRO KODU : Sub ListelemeYap() 'Sheetlere göre listeleme yapar' Sheets.Add With Sheets(1) For i = 1 To Sheets.Count Cells(i, 1) = Sheets(i).Name .Hyperlinks.Add Anchor:=Cells(i, 1), _ Address:="", SubAddress:=Sheets(i).Name & "!A1" Sheets(i).Range("A1") = Sheets(1).Name Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("A1"), _ Address:="", SubAddress:=Sheets(1).Name & "!A1" Next End With End Sub

ID : 1733
ISLEM : sayfa adlarını renklendirme
MAKRO KODU : Sub Makro1() Sheets("Sayfa2").Tab.ColorIndex = 33 End Sub

ID : 1734
ISLEM : sayfa adlarinin (sekme adi) listelenmesi
MAKRO KODU : Private Sub OptionButton1_Click() Dim i As Integer Dim j As Integer Label1.Caption = "" If Worksheets.Count = 1 Then Exit Sub For i = 1 To Worksheets.Count Sheets(i).Name = LCase(Sheets(i).Name) For j = i + 1 To Worksheets.Count If LCase(Worksheets(j).Name) < LCase(Worksheets(i).Name) Then Worksheets(j).Move Before:=Worksheets(i) End If Next j Next i For i = 1 To Sheets.Count ListBox1.AddItem Sheets(i).Name Next Sheets("ana sayfa").Move Before:=Sheets(1) End Sub

ID : 1735
ISLEM : sayfa aktif olunca mesaj verme
MAKRO KODU : Private Sub Worksheet_Activate() MsgBox "Abarini kimi görirem", vbInformation, "Hoş gelmişen la kıro" End Sub

ID : 1736
ISLEM : sayfa aktif olunca sol üstbilgi olarak tarihi ekleme
MAKRO KODU : Private Sub Worksheet_Activate() datum = Format(Date, "yyyy-mm-dd") Worksheets("Tabelle1").PageSetup.LeftHeader = datum End Sub

ID : 1737
ISLEM : sayfa aktifleşince makro çalıştırma
MAKRO KODU : Private Sub Worksheet_Activate() Makroname 'Makroname write End Sub

ID : 1738
ISLEM : sayfa alfabetik sıralama gizli sayfaları da sıralar türkçe karakter sorunu olmaz
MAKRO KODU : Sub sayfasirala() Application.ScreenUpdating = False Sheets.Add ActiveSheet.Move After:=Sheets(Sheets.Count) Set s1 = Sheets(Sheets.Count) For a = 1 To Sheets.Count - 1 s1.Cells(a, "a") = Sheets(a).Name s1.[a:a].Sort Key1:=s1.[a1] deg = Sheets(a).Name If IsNumeric(deg) = True Then deg = Val(Sheets(a).Name) say = WorksheetFunction.Match(deg, s1.[a:a], 0) Sheets(a).Move Before:=Sheets(say) Next Application.DisplayAlerts = False s1.Delete End Sub

ID : 1739
ISLEM : sayfa alfabetik sıralama gizli sayfaları da sıralar türkçe karakter sorunu olmaz 2
MAKRO KODU : Sub alfabetik_sirala() Application.ScreenUpdating = False Sheets(1).Select Say = Sheets.Count If Say < 2 Then Exit Sub Sheets.Add ActiveSheet.Name = "Liste" For X = 2 To Sheets.Count Sheets("Liste").Cells(X - 1, 1) = Sheets(X).Name If Sheets(X).Visible = False Then Sheets(X).Visible = True Sheets("Liste").Cells(X - 1, 2) = "Gizli" End If Next Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending [A1].Select For Y = 2 To Sheets.Count Sheets("" & Cells(Y - 1, 1)).Move Before:=Sheets(Y) Sheets("Liste").Select If Sheets("Liste").Cells(Y - 1, 2) = "Gizli" Then Sheets("" & Cells(Y - 1, 1)).Visible = False End If Next Application.DisplayAlerts = False Sheets("Liste").Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

ID : 1740
ISLEM : sayfa çoğaltma
MAKRO KODU : Sub cogalt() For a = 1 To 10 Sheets("Sayfa1").Copy After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = a Next End Sub