DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Compare Text
Sub Aktar()
Dim i As Long, _
j As Long, _
Adet As Integer, _
Liste As Worksheet, _
Arşiv As Worksheet
Set Liste = Sheets("genel liste")
Set Arşiv = Sheets("arşiv")
Liste.Select
j = Arşiv.Cells(Rows.Count, "B").End(3).Row 'Arşiv sayfasının son dolu satırı
For i = Liste.Cells(Rows.Count, "B").End(3).Row To 1 Step -1
If Cells(i, "K") Like "Pasif*" Then
j = j + 1
With Range("B" & i & ":K" & i)
.Copy Arşiv.Range("B" & j)
.Delete xlUp
End With
End If
Next i
End Sub
Set Arşiv = Sheets("[COLOR=red]arşiv[/COLOR]")
Selamlar,
1. sorunuz için sadece alttaki kodu değiştirmeniz gerekir.
Kod:Set Arşiv = Sheets("[COLOR=red]arşiv[/COLOR]")
merhaba onu denedim "genel "yaptığımda çalışmıyor( arşiv1 yaptığımda çalışıyor anlamadım gitti.