macroya satıra göre sildirme ekleme

[incsoft]

Arkadaşlar formumda 4 adet sütunum ve yaklaşık 500 satır bulunmaktadır ve burada "D" sütünunda yani D1,D2,D3.... adı PASİF olanları sildirerek bunu bilgisayarımdaki D sürücüsüne sure.csv dosyası olarak kaydettirmek istiyorum.Daha önceden başka bir amaçla kullandığım macrom vardı ancak buna PASİF olanları buldurup sildirme komutu ekleyemedim. Bu konuda da yardımlarınıza ihtiyacım var. Her seferinde filtre uygulayıp PASİF olanları süzdürüp sildirdikten sonra kaydet demek istemiyorum. Teşekkürler..

Private Sub CommandButton1_Click()


SatırNo = 0
For I = 1 To 700
If Left(Trim(Cells(I, 1)), 1) <> "T" Then
SatırNo = I - 1
Exit For
End If
Next I
'MsgBox SatırNo


Text123 = "A1" & SatırNo
Range(Text123).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ChDir "D:\"
ActiveWorkbook.SaveAs Filename:= _
"D:\SURE.csv", FileFormat:=xlCSV, _
CreateBackup:=False

End Sub

 

[asi_kral]

Merhaba
Kodu bununla değiştirip dener misiniz ?

Private Sub CommandButton1_Click()
Dim STR As Long
Application.DisplayAlerts = False
STR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:D" & STR).AutoFilter 4, "PASİF"
If WorksheetFunction.Subtotal(3, Range("A2:A" & STR)) > 0 Then
Range("A2:D" & STR).Delete
End If
Range("A1:D" & STR).AutoFilter
Application.DisplayAlerts = True
SatırNo = 0
For I = 1 To 700
If Left(Trim(Cells(I, 1)), 1) <> "T" Then
SatırNo = I - 1
Exit For
End If
Next I
'MsgBox SatırNo
Text123 = "A1" & SatırNo
Range(Text123).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ChDir "D:\"
ActiveWorkbook.SaveAs Filename:= _
"D:\SURE.csv", FileFormat:=xlCSV, _
CreateBackup:=False
End Sub

Sadece pasifleri sildirdim. Siz .cvs olarak kayıt yaptırmışsınız anladığım kadarı ile