Makro ile veri aktarımı

[alimutlu2308]

Arkadaşlar bir konu hakkında tekrar yardımınıza muhtacım. Aşağıya eklemiş olduğum tabloda sheet1'de "O" sütununda durumu bölümünde aktif yazıyor ise "D" , "E" , "F" ve "L" sütunundaki bilgileri başka bir sheet"e makro ile aktarabileceğimiz bir kod varmıdır. Eğer sütünda pasif yazıyor ise hiç bir işlem yapılmıyacak. Konu hakkında yardımlarınızı rica ederim.

 

[Orion1]

Dosyanız ektedir.

Sub aktar59()
Dim sh As Worksheet, sat1 As Long, sat2 As Long, i As Long
Sheets("Sheet1").Select
Application.ScreenUpdating = False
Set sh = Sheets("Sheet2")
sh.Range("A2:D" & Rows.Count).ClearContents
sat1 = Cells(Rows.Count, "D").End(xlUp).Row
sat2 = 2
For i = 2 To sat1
    If UCase(Replace(Replace(Cells(i, "O").Value, "i", "İ"), "ı", "I")) = "AKTİF" Then
        sh.Cells(sat2, "A").Value = Cells(i, "D").Text
        sh.Cells(sat2, "B").Value = Cells(i, "E").Value
        sh.Cells(sat2, "C").Value = Cells(i, "F").Value
        sh.Cells(sat2, "D").Value = Cells(i, "L").Value
        sat2 = sat2 + 1
    End If
Next i
sh.Select
Application.ScreenUpdating = True
Set sh = Nothing
MsgBox "veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName

End Sub

 

[alimutlu2308]

İlginiz ve emeğiniz için çok teşekkür ederim. On numara olmuş. Saygılar,

 

[unur]

Arkadaşlar, başka bir konu başlığı açmak yerine en yakın başlık olarak bunu buldum.
Kodlardan anlamadığım için yazmak zorunda kaldım.
Basit olarak şöyle bir şeye ihtiyacım var.
Örnek olarak: Sayfa1 deki B5,B6,B7,B8 ve B15,B16,B17,B18'deki verileri, Sayfa2'de B,C,D,E,F,G,H,I sütunlarına ve en son dolu satıra butonla aktarmak istiyorum.
2. Aktarma öncesinde ise Sayfa2'deki C,F,H sütunlarındaki verilere bakıp daha önce aktarıldıysa daha önce işlem yapıldı şeklinde uyarı vermesini, iptal edilirse aktarmamasını, tamam denirse aktarmasını istiyorum.
Umarım anlatabilmişimdir.
Yardımcı olacak arkdaşlara şimdiden teşekkürler.

 

[unur]

Günaydın arkadaşlar.
yukarıdaki soruyu güncellemek için.

 

[unur]

Bu konuda yardımcı olacak arkadaş yokmu? 4 mesajdaki soru. Teşekkürler.