Merhaba
Aşağıdaki makro ile aynı çalışma kitabında sipariş sayfasındaki H sutunun da hangi hücreye bir değer yazarsam değer yazdığım hücrenin bulunduğu satırı biten sipariş sayfasına taşıyorum.
1-Ancak ben bunu herhangi bir değer değil "BİTTİ" yazdığımda ve formülsüz yani yalnızca değerleri taşısın istiyorum. Bunun için aşağıdaki makroyu nasıl düzenlemem gerek.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1 As Worksheet, STR As Long
Dim ÇLŞ As Variant, SÇLŞ As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("H:H")) Is Nothing Then _
Application.ScreenUpdating = True: _
Application.EnableEvents = True: Exit Sub
If Target <> Empty Then
Set S1 = Sheets("TAMAMLANAN SİPARİŞLER")
STR = S1.Range("B" & Rows.Count).End(xlUp).Row + 1
If STR < 7 Then
STR = 7
End If
Range("B" & Target.Row & ":H" & Target.Row).Copy _
S1.Range("B" & STR)
Application.DisplayAlerts = False
Range("B" & Target.Row & ":H" & Target.Row).Delete xlUp
Application.DisplayAlerts = True
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
2- Gelen sayfasında da üstteki makro ile aşağıdaki makroyu yu birlikte kullanabilmek için yani ikisini de aynı sayfada kullanabilmek için nasıl bir yol izlemem gerekir.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim kitap As Workbook, Syf As Worksheet, veri As Long
Application.ScreenUpdating = False
If Selection.Count > 1 Then Exit Sub
If Intersect(Target, Range("AD3:AD" & Cells(Rows.Count, 1).End(3).Row)) Is Nothing Then Exit Sub
' Application.EnableEvents = False
If Target = "İ" Then
ThisWorkbook.Sheets("GELEN").Range("B" & Target.Row & ":AB" & Target.Row).Copy
Set kitap = Workbooks.Open("W:\KAYIT\CARİ.xlsm")
Set Syf = kitap.Sheets("GİRİŞ")
kitap.Activate
Syf.Cells(Syf.Cells(Rows.Count, 2).End(3).Row + 1, 2).PasteSpecial xlValues
End If
' Application.EnableEvents = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
son = Empty: Set Syf = Nothing: Set kitap = Nothing
End Sub
örnek dosya linki eklenmiştir. Şimdiden teşekkürler.
Aşağıdaki makro ile aynı çalışma kitabında sipariş sayfasındaki H sutunun da hangi hücreye bir değer yazarsam değer yazdığım hücrenin bulunduğu satırı biten sipariş sayfasına taşıyorum.
1-Ancak ben bunu herhangi bir değer değil "BİTTİ" yazdığımda ve formülsüz yani yalnızca değerleri taşısın istiyorum. Bunun için aşağıdaki makroyu nasıl düzenlemem gerek.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1 As Worksheet, STR As Long
Dim ÇLŞ As Variant, SÇLŞ As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("H:H")) Is Nothing Then _
Application.ScreenUpdating = True: _
Application.EnableEvents = True: Exit Sub
If Target <> Empty Then
Set S1 = Sheets("TAMAMLANAN SİPARİŞLER")
STR = S1.Range("B" & Rows.Count).End(xlUp).Row + 1
If STR < 7 Then
STR = 7
End If
Range("B" & Target.Row & ":H" & Target.Row).Copy _
S1.Range("B" & STR)
Application.DisplayAlerts = False
Range("B" & Target.Row & ":H" & Target.Row).Delete xlUp
Application.DisplayAlerts = True
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
2- Gelen sayfasında da üstteki makro ile aşağıdaki makroyu yu birlikte kullanabilmek için yani ikisini de aynı sayfada kullanabilmek için nasıl bir yol izlemem gerekir.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim kitap As Workbook, Syf As Worksheet, veri As Long
Application.ScreenUpdating = False
If Selection.Count > 1 Then Exit Sub
If Intersect(Target, Range("AD3:AD" & Cells(Rows.Count, 1).End(3).Row)) Is Nothing Then Exit Sub
' Application.EnableEvents = False
If Target = "İ" Then
ThisWorkbook.Sheets("GELEN").Range("B" & Target.Row & ":AB" & Target.Row).Copy
Set kitap = Workbooks.Open("W:\KAYIT\CARİ.xlsm")
Set Syf = kitap.Sheets("GİRİŞ")
kitap.Activate
Syf.Cells(Syf.Cells(Rows.Count, 2).End(3).Row + 1, 2).PasteSpecial xlValues
End If
' Application.EnableEvents = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
son = Empty: Set Syf = Nothing: Set kitap = Nothing
End Sub
örnek dosya linki eklenmiştir. Şimdiden teşekkürler.