DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Public Eski As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Selection.SpecialCells(xlCellTypeFormulas, 23).Replace What:=Eski, Replacement:=[A1], LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Son:
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Eski = [A1]
Son:
End Sub
say = Range("A65536").End(3).Row + 1
If say = 3 Then
Cells(say, 1).Value = 1
Else
Cells(say, 1).Value = Cells(say - 1, 1).Value + 1
End If
For i = 1 To 5
Cells(say, i + 1).Value = Me.Controls("TextBox" & i)
Next
Sub BUL_AKTAR()
Worksheets("tüm satışlar").Unprotect
Dim s1 As Worksheet, s2 As Worksheet, BUL As Range, ADRES As String
Set s1 = Sheets("SATIŞ KAYDI")
Set s2 = Sheets("tüm satışlar")
Set BUL = s2.Range("A:A").Find(s1.Range("ı1"), , , xlWhole)
If Not BUL Is Nothing Then
ADRES = BUL.Address
Do
If s1.Range("ı2") = BUL.Offset(0, 1) Then
If s1.Range("ı3") = BUL.Offset(0, 2) Then
If s1.Range("ı6") = BUL.Offset(0, 5) Then
If s1.Range("ı10") = BUL.Offset(0, 9) Then
s1.Range("ı1:ı14").Copy
s2.Range("A" & BUL.Row).PasteSpecial xlPasteValues, , , True
Application.CutCopyMode = False
MsgBox "Veriler aktarılmıştır.", vbInformation
Exit Do
End If
End If
End If
End If
Set BUL = s2.Range("A:A").FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
End If
Set BUL = Nothing
Set s1 = Nothing
Set s2 = Nothing
Worksheets("tüm satışlar").Protect
End Sub