DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Bu isteğinizi pek anlayamadım. İstediğiniz aktarım şeklini örnek bir dosyada manuel olarak girip ekler misiniz?s.a.
ustam sağolasın, ellerin dert görmesin.
birde sayfa1 deki veriler alt alta olsaydı, yani adı soyadı a1 de, tc kimlik no b1 de, ünvanı c1 de olsaydı, sayfa 2 ye tek satıra kaydedecek şekilde makroyu nasıl düzenlerdik. bilgilendirirsen sevinirim
hocam benimde bir sorum olacak aynı konuda ek'i gönderiyorum yardımlarınızı bekliyorum
Kod:Sub Aktar() Set s2 = Sheets("Sayfa2") Sat = s2.[a65536].End(3).Row + 1 For x = 1 To 3 s2.Cells(Sat, x) = Cells(x, "b") Next End Sub
Syn. cılgın86'lı,
Ne istediğiniz tam anlaşılmıyor. Sanırım aynı aya denk gelen satırları öteki sayfaya aktarmak istiyorsunuz. Peki diğer sayfada var olan veriler ne olacak. Belli bir satırdan sonra toplam satırı vs. var. Aktarım bir süre sonra buraya ulaşacak. Buradaki satırlar ister istemez silinecek. vs. vs.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HÜCRE As Range
Set s2 = Sheets("M1")
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If IsDate(Target) Then
[COLOR="Red"] s2.[b5:g79,I5:I79] = ""[/COLOR]
For Each HÜCRE In Range("B3:B" & Range("B65536").End(3).Row)
If Format(HÜCRE.Value, "m") = Format(Target, "m") And Year(HÜCRE.Value) = Year(Target) Then
Sat = s2.[b79].End(3).Row + 1
If Sat = 5 Then Sat = Sat + 1
s2.Cells(Sat, "b") = HÜCRE
s2.Cells(Sat, "e") = Cells(HÜCRE.Row, "c")
s2.Cells(Sat, "d") = Cells(HÜCRE.Row, "d")
s2.Cells(Sat, "f") = Cells(HÜCRE.Row, "f")
s2.Cells(Sat, "c") = Cells(HÜCRE.Row, "e")
s2.Cells(Sat, "g") = Cells(HÜCRE.Row, "g")
s2.Cells(Sat, "I") = Cells(HÜCRE.Row, "h")
End If
Next
MsgBox "İşlem tamam.", vbInformation
End If
Application.ScreenUpdating = True
End Sub
=DÜŞEYARA($A18;Sayfa1!$A:$F;2;0)
=DÜŞEYARA($A18;Sayfa1!$A:$F;3;0)
=DÜŞEYARA($A18;Sayfa1!$A:$F;6;0)
=DÜŞEYARA($A18;Sayfa1!$A:$F;4;0)
=DÜŞEYARA($A18;Sayfa1!$A:$F;5;0)