Excel'le Adım Adım Program Yazma

A1:h1 satırlarını diğer sayfalara da uygulatın.

Sub FillAll()
    Worksheets("Sheet2").Range("A1:H1") _
        .Borders(xlBottom).LineStyle = xlDouble
    Worksheets.FillAcrossSheets (Worksheets("Sheet2") _
        .Range("A1:H1"))
End Sub

A1:j44 harici hücreleri gizleme

Sub gizle()
Columns("K:IV").Hidden = True
Rows("45:65536").Hidden = True
End Sub

A1:j44 harici hücreleri gösterme

Sub göster()
Columns("K:IV").Hidden = False
Rows("45:65536").Hidden = False
End Sub

A1=1 ise yanıp sönsün 0 ise dursun.

sayfanın kod bölümüne yapıştırın
Option Explicit
Public CellCheck As Boolean
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Range("A1") = "1" And CellCheck = False Then
    Call StartBlink
    CellCheck = True
ElseIf Range("A1") <> "1" And CellCheck = True Then
    Call StopBlink
    CellCheck = False
End If
End Sub
'modüle yapıştırın
Option Explicit
Public RunWhen As Double
Sub StartBlink()
    If Range("A1").Interior.ColorIndex = 3 Then
        Range("A1").Interior.ColorIndex = 6
    Else
        Range("A1").Interior.ColorIndex = 3
    End If
    RunWhen = Now + TimeSerial(0, 0, 1)
    Application.OnTime RunWhen, "StartBlink", , True
End Sub
Sub StopBlink()
    Range("A1").Interior.ColorIndex = xlAutomatic
    Application.OnTime RunWhen, "StartBlink", , False
End Sub

A1=1, c1=3, b sütunu ise gizli olsun. Sayfa2 ye a1=1, b1=3 olur

Sub sichtbare_kopieren()
Range("A1").CurrentRegion _
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Tabelle2").Range("A1")
End Sub

A16:g28 hücrelerini seçer ve 0 yapar

Sub ResetTest2()
For Each n In Range("A16:G28")
    If IsNumeric(n) Then
        n.Value = 0
    End If
Next n
End Sub

A1-a20 arasına veri girersen mesaj verir.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Schnittpunkt As Range
Set Schnittpunkt = Application.Intersect(Target, Me.Range("A1:A20"))
If Schnittpunkt Is Nothing Then
Exit Sub
Else
MsgBox "A1-A20 arasına veri girildi"
End If
End Sub

A1-a5 arasının ilk harflerini büyük harfe çevirir

Sub ilkharfler_buyuk()
For i = 1 To 5
Range("A" & i).Select
t = ActiveCell
s = Len(t)
u = UCase(Left(t, 1)) & Right(t, s - 1)
Range("A" & i) = u
Next i
End Sub

hücrelerde eğer herhangi bir veri varsa kırmızı yapar ve satırı tamamen sayfa 3 'e gönder

Sub DENE_1()
Range("1:3000").Interior.ColorIndex = xlNone
For x = 1 To 3000
If Cells(x, 1).Value <> Empty Then
Rows(x).Interior.ColorIndex = 3
End If
Next x
End Sub

Sub DENE_2()
For x = 1 To 3000
If Cells(x, 1).Value <> Empty Then
Rows(x).Cut
Sheets("Sayfa3").Select
son = [a65536].End(3).Row + 1
Cells(son, 1).Select
ActiveSheet.Paste
Sheets("Sayfa1").Select
End If
Next x
End Sub

Sub DENE_3()
For x = 1 To 3000
yeniden:
If Cells(x, 1).Value <> Empty Then
Rows(x).Cut
Sheets("Sayfa3").Select
son = [a65536].End(3).Row + 1
Cells(son, 1).Select
ActiveSheet.Paste
Sheets("Sayfa1").Select
Rows(x).Delete
GoTo yeniden
End If
Next x
End Sub

A2 deki tarihi gün ay yıl olarak b2,c2,d2 ye alır.


Sub datum_splitten()
z = 2
Do While Cells(z, 1) <> ""
Cells(z, 2).NumberFormat = "@"
Cells(z, 2) = Left(Cells(z, 1), 2)
Cells(z, 3).NumberFormat = "@"
Cells(z, 3) = Mid(Cells(z, 1), 4, 2)
Cells(z, 4).NumberFormat = "@"
Cells(z, 4) = Right(Cells(z, 1), 2)
z = z + 1
Loop
End Sub

A2 hücresiyle birbiri üzerine ekleme


Sub NomOnglet()
Dim Name As String
Name = Range("A2")
Application.ScreenUpdating = False
ActiveSheet.Name = (Name)
End Sub

A3  seç 2 satır aşağı ve 2 satır yana 5 yaz


Sub satsut()
Range("A3").Offset(2, 2) = 5
End Sub

A3 e ne yazarsan b7 de aynısı

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rMonitor As Range
    Dim rTarget As Range

    Set rMonitor = Range("A3")
    Set rTarget = Range("B7")

    If Not Intersect(Target, rMonitor) Is Nothing Then
        rMonitor.Copy rTarget
    End If

    Set rMonitor = Nothing
    Set rTarget = Nothing
End Sub

A3:f15 hücreleri arasındaki verileri yazdırır


Sub PrintRpt3()
With Worksheets("Sayfa1").PageSetup
.CenterHorizontally = True
.PrintArea = "$A$3:$F$15"
.PrintTitleRows = ("$A$1:$A$2")
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Worksheets("Sayfa1").PrintOut
End Sub

A5 =2 ise userform açılmasın


Sub Auto_Open()
If Range("a5") <> 2 Then
UserForm1.Show
ActiveWorkbook.Save
Else
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End Sub