Merhaba alttaki makroyu forumda adını hatırlamadığım bir arkadaş hazırlamıştı. Sorun şu "ET" yazılı satırları kesip diğer sayfaya aktarıyor ama "et" olursa almıyor bu sorunu nasıl halledebiliriz?
Sub AKTAR()
Dim ALAN1 As Range
Dim ALAN2 As Range
Set S1 = Sheets("LFPLAN")
Set S2 = Sheets("LFPLANET")
Application.Calculation = xlCalculationManual
S2.[A2:O65536].ClearContents
SATIR = 2
For Each ALAN1 In S1.[A2:A198].SpecialCells(xlCellTypeConstants, 23)
If ALAN1.Offset(0, 11) = "ET" Then
S2.Range("A" & SATIR & ":O" & SATIR).Value = S1.Range("A" & ALAN1.Row & ":O" & ALAN1.Row).Value
S1.Range("A" & ALAN1.Row & ":O" & ALAN1.Row).Value = ""
SATIR = SATIR + 1
End If
Next
S1.[A2:O198].Sort Key1:=[A2], Order1:=xlAscending
SATIR = 41
For Each ALAN2 In S1.[A200:A65536].SpecialCells(xlCellTypeConstants, 23)
If ALAN2.Offset(0, 11) = "ET" Then
S2.Range("A" & SATIR & ":O" & SATIR).Value = S1.Range("A" & ALAN2.Row & ":O" & ALAN2.Row).Value
S1.Range("A" & ALAN2.Row & ":O" & ALAN2.Row).Value = ""
SATIR = SATIR + 1
End If
Next
S1.[A200:O65536].Sort Key1:=[A200], Order1:=xlAscending
S2.Select
Set S1 = Nothing
Set S2 = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub
Sub AKTAR()
Dim ALAN1 As Range
Dim ALAN2 As Range
Set S1 = Sheets("LFPLAN")
Set S2 = Sheets("LFPLANET")
Application.Calculation = xlCalculationManual
S2.[A2:O65536].ClearContents
SATIR = 2
For Each ALAN1 In S1.[A2:A198].SpecialCells(xlCellTypeConstants, 23)
If ALAN1.Offset(0, 11) = "ET" Then
S2.Range("A" & SATIR & ":O" & SATIR).Value = S1.Range("A" & ALAN1.Row & ":O" & ALAN1.Row).Value
S1.Range("A" & ALAN1.Row & ":O" & ALAN1.Row).Value = ""
SATIR = SATIR + 1
End If
Next
S1.[A2:O198].Sort Key1:=[A2], Order1:=xlAscending
SATIR = 41
For Each ALAN2 In S1.[A200:A65536].SpecialCells(xlCellTypeConstants, 23)
If ALAN2.Offset(0, 11) = "ET" Then
S2.Range("A" & SATIR & ":O" & SATIR).Value = S1.Range("A" & ALAN2.Row & ":O" & ALAN2.Row).Value
S1.Range("A" & ALAN2.Row & ":O" & ALAN2.Row).Value = ""
SATIR = SATIR + 1
End If
Next
S1.[A200:O65536].Sort Key1:=[A200], Order1:=xlAscending
S2.Select
Set S1 = Nothing
Set S2 = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub