- Katılım
- 28 Tem 2022
- Mesajlar
- 370
- Excel Versiyonu
- Excel 2016
- Excel Sürümü
- 64 Bit
- Excel Dili
- Türkçe
Hayırlı sabahlar kıymetli hocalarım ve sayfa takipçileri 

Ekli dosyalar
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
Columns("S:S").Select
Cells.Find(What:=Target.Value).Select
Target.Offset(0, 6).Value = Range(ActiveCell.Address).Offset(0, 1).Value
Target.Offset(1, 0).Select
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
Application.EnableEvents = False
If (Target.Column = 1 Or Target.Column = 4) And Target.Row > 1 Then
For a = 10 To 8000 Step 32
If Target.Row = a And Target.Column = 1 Then
Cells(Target.Row - 2, 1) = Date
Exit For
ElseIf Target.Row = a + 23 And Target.Column = 4 Then
Cells(Target.Row, 3) = Date
Exit For
End If
Next a
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count = 1 Then 'Exit Sub
Application.EnableEvents = False
If (Target.Column = 1 Or Target.Column = 4) And Target.Row > 1 Then
For a = 10 To 8000 Step 32
If Target.Row = a And Target.Column = 1 Then
Cells(Target.Row - 2, 1) = Date
Exit For
ElseIf Target.Row = a + 23 And Target.Column = 4 Then
Cells(Target.Row, 3) = Date
Exit For
End If
Next a
End If
End If
Application.EnableEvents = True
'----------------------------------------------------------------------------
If Target.Column <> 2 Then Exit Sub
Application.ScreenUpdating = False
Columns("S:S").Select
Cells.Find(What:=Target.Value).Select
Target.Offset(0, 6).Value = Range(ActiveCell.Address).Offset(0, 1).Value
Target.Offset(1, 0).Select
Application.ScreenUpdating = True
End Sub
Target.Offset(0, 6).Value = Range(ActiveCell.Address).Offset(0, 1).Value
https://drive.google.com/file/d/1MbiDXRoyS0fSjE4DU6L7PqcjtM-sglKV/view?usp=sharing
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
Application.EnableEvents = False
If (Target.Column = 1 [COLOR=rgb(132, 53, 52)]Or Target.Column = 2[/COLOR] Or Target.Column = 4) And Target.Row > 1 Then
For a = 10 To 8000 Step 32
If Target.Row = a And Target.Column = 1 Then
Cells(Target.Row - 2, 1) = Date
Exit For
ElseIf Target.Row = a + 23 And Target.Column = 4 Then
Cells(Target.Row, 3) = Date
Exit For
[COLOR=rgb(132, 53, 52)] ElseIf Target.Row >= a And Target.Row <= a + 19 And Target.Column = 2 Then
Set bul = [R:R].Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
If Not bul Is Nothing Then Target.Offset(0, 6) = Cells(bul.Row, "S")
If bul Is Nothing Then: MsgBox "YAzılan ürün listede yok !", vbCritical
Exit For[/COLOR]
End If
Next a
End If
Application.EnableEvents = True
End Sub
Çalışma Sayfasını Başka Kitaba Kopyalama
|
|
Sekmeleri Başka Bir Sayfaya Makro ile Alma
|
|
Verileri Başka Bir Klasördeki Dosyaya Yazdırma
|
|
Başlangıç Değerine Göre Satırları Başka Sayfaya Kopyalamak
|
|
Verileri Başka Bir Excel Sayfasından Çekme
|