Excel'le Adım Adım Program Yazma

A sütununda aynı olanları sayfa alanı olarak ayırır.

Sub SetzeSeiten()
Dim rngBereich As Range
Dim rngZelle As Range
Application.ScreenUpdating = False
On Error GoTo Ende
Set rngBereich = Range("A1:A" & Range("A2").End(xlDown).Row)
Cells.PageBreak = xlNone
For Each rngZelle In rngBereich
  If rngZelle <> rngZelle.Offset(1, 0) Then rngZelle.Offset(1, 0).PageBreak = xlPageBreakManual
Next rngZelle
Ende:
Application.ScreenUpdating = True
End Sub

A sütununda boş satırları siler

Sub bossatirsil()
For a = 1 To Sheets.Count
sat = Sheets(a).Cells.SpecialCells(xlCellTypeLastCell).Row
sut = Sheets(a).Cells.SpecialCells(xlCellTypeLastCell).Column
For b = sat To 1 Step -1
If WorksheetFunction.CountA(Sheets(a).Rows(b)) = 0 Then Sheets(a).Rows(b).Delete
Next
For c = sut To 1 Step -1
If WorksheetFunction.CountA(Sheets(a).Columns(c)) = 0 Then Sheets(a).Columns(c).Delete
Next
Next
End Sub

A sütununda boşlukları aldırma doluları listeleme

Sub Leerzeilenlöschen()
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

A sütununda bugünü bulsun

Sub bugunu_bul()
Dim lr As Long
Dim i As Integer
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lr
If Cells(i, 1).Value = Date Then
Cells(i, 1).Select
End
End If
Next i
End Sub

A sütununda en son sırada olan veriyi b1 e kopyalar

Sub LetztenWertKopieren()
   Dim intCol As Integer
   intCol = 1 '1 steht für Spalte A
   Cells(Rows.Count, intCol).End(xlUp).Copy _
   Range("B1")
End Sub

A sütununda herhangi bir hücreye tıkla satır numarasını versin

Sayfanın kod bölümüne
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    rowoffset = 0
    Intersect(ActiveCell.EntireRow, Columns("A")).Value = ActiveCell.Row + rowoffset
End Sub

A sütununda verilere göre sayfa ekler ve d sütununa kadar olan verileri de yazar

Selection.Cut
ActiveSheet.Shapes("Button 2").Select
Selection.Cut
basla:
If [A2] = "" Then Exit Sub
Set sayfa = ActiveSheet
Columns("A:D").EntireColumn.AutoFit
sayfa.Name = [A2]
Set sec = [A2].CurrentRegion.Columns(1).ColumnDifferences([A2])
Set sec = Intersect(sec.EntireRow, [A:D])
If sec.Address = "" Then Exit Sub
Worksheets.Add after:=Sheets(Worksheets.Count)
Set sonsayfa = Sheets(Worksheets.Count)
sayfa.Select
For Each alan In sec.Areas
    alan.Copy
    sat = sonsayfa.[a65536].End(3).Row + 1
    sonsayfa.Cells(sat, 1).Insert shift:=xlDown
    alan.Delete shift:=xlUp
Next
Set sec = Nothing
sonsayfa.Select
GoTo basla
End Sub

A sütunundaki aynı değerleri öbür sayfada süzüp b deki toplamlarını ilave ederSub aktar()
Dim isim, deger As Variant
Dim rng As Range
Dim i, z As Integer
i = 2
z = 1
Do
If Cells(i, 1).Value = "" Then GoTo bitti
If Range([A1], [A10000]).Find(What:=Cells(i, 1).Value, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows).Row < i Then GoTo devam2
    ReDim isim(z)
    ReDim deger(z)
    isim(z) = Cells.Find(What:=Cells(i, 1).Value, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows).Value
    deger(z) = Cells(i, 1).Offset(0, 1).Value
    hcr = i
      Do
      On Error Resume Next
      Set rng = Range(Cells(hcr, 1), [A10000]).FindNext
      If rng.Row = hcr Then GoTo devam
      hcr = rng.Row
      deger(z) = deger(z) + rng.Offset(0, 1).Value
      Loop
devam:
Sheets(2).Cells(z, 1).Value = isim(z)
Sheets(2).Cells(z, 2).Value = deger(z)
z = z + 1
devam2:
i = i + 1
Loop
bitti:
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

A sütunundaki dolu hücreleri bulur ve yazdırma alanı içine alır
 

Sub setPrintArea()
   Dim rng As Range
   Set rng = ActiveSheet.Cells.SpecialCell s(xlCellTypeLastCell)
   stcell = "A1": lcell = rng.Address
   ActiveSheet.PageSetup.PrintAr ea = stcell & ":" & lcell
End Sub

A sütunundaki en büyük sayyı bulur.

Private Sub UserForm_Initialize()
TextBox1.Value = WorksheetFunction.Max(Range("A:A"))
End Sub

A sütunundaki en son veriyi b1 e yaz

Sub enbuyuk()
   Dim intCol As Integer
   intCol = 1 '1 steht für Spalte A
   Cells(Rows.Count, intCol).End(xlUp).Copy _
   Range("B1")
End Sub

A sütunundaki sayılara 1 ekler c sütununa yazar

Sub ekle1yazC()
Dim MaValeur, compteur
For compteur = 1 To 15
Range("A" & compteur).Select
MaValeur = ActiveCell.Value
Range("C" & compteur).Select
ActiveCell.Value = MaValeur + 1
Next
End Sub

A sütunundakiler combboxta, combobox seçilince B,C,D dekiler textboxa yazılır

Private Sub ComboBox1_Change()
Dim I As Long
    For I = 1 To 3
        Me.Controls("TextBox" & I) = Range("A" & ComboBox1.ListIndex + 1).Offset(, I)
    Next I
End Sub

A sütunundakileri 100 ile toplar b sütununa yazar

Sub topla100yazB()
Dim MaValeur, nbcell
For nbcell = 1 To 10
Range("A" & nbcell).Select
MaValeur = ActiveCell.Value
Range("B" & nbcell).Select
ActiveCell.Value = MaValeur + 100
Next
End Sub