Sayfada bulunan satırlardaki Verileri Başka sayfada sütunlara aktarmak

[htsumer]

Sayfa1'de bulunan verileri Sayfa2'ye sütun olarak aktarılmasına ait makrto ihtiyacım var.. Dosya ektedir ve içeriğinde açıklama yazılmıştır.

Dosya indiremeyenler için link:
https://dosya.co/5kzncwlj6grt/test_1.xlsx.html

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[htsumer]

Sayın muygun,
Verilerin gelmesi derken sadece isimler değil. Satfa1'deki tüm veriler sayfa2'ye o formatta gelecek..
Ücret türleri Satfa1 de ne varsa bu türler bazen 3-4 olabiliyor bazende fazla olabiliyor..

 

[muygun]

Merhaba;
Açıklamanız net değil.
Tüm veriler derken Sayfa1 sayfasında E sütunundaki başlıkların Sayfa2 sayfasında 6. satırda konumlanmaları ise bunu makroya aldırdım. (başka bir anlam çıkaramadım)
Eki tekrar deneyin.
İyi çalışmalar.

 

[htsumer]

Hocam süpersin süper... Harika oldu tam istediğim gibi Allah razı olsun senden..Çok çok teşekkür ederim..

 

[htsumer]

Hocam Test kişi ekledim test ücret de ekledim ve değeri yazdım


Aktar dediğimde aktardı




Daha sonra Sayfa1 den bazı kişileri sildim ortadan




Tekrar aktar dediğimde son eklediğim teste ait değer kalıyor.
Aktar öncesi sayfanın ilgili kısımlarını silsek

 

[muygun]

Merhaba;
Eki tekrar deneyin.
İyi çalışmalar.

 

[htsumer]

Teşekkür ederim 3-4 gündür pc başına oturamadım akşam deneyip bildireceğim elinize sağlık

 

[htsumer]

Hocam çok teşekkür ederim tam anlamıyla harika ve çözüme ulaştı. Emeğinize ve elinize sağlık..

 

[htsumer]

Ufak bir detayı atlamışım.. Verdiğim örnekte veri aktarımı sabit gib dursada veri aktarım yeri 31 çeken aylarda kayma yapıyor.
Eylül ayı 30 olduğundan aşağıdaki kod işe yarıyor. Ama Ekim seçtiğimde sayfamda bir sütun daha eklendiği için

s2.Cells(i, k) = s1.Cells(sırası, "aj")
bu AJ sütunu 31 olan aylarda AK olarak kayıyor. Dolayısıyla Toplam yerine AJ sütundaki değerleri getiriyor.. Bunu nasıl ayarlayabiliriz. 31 çeken aylarda AJ sütununu baz alacak, 30 çeken aylarda AK sütununu

Bu durumda iken sadece 5'ler geliyor.. Ama Eylül yada 30 çeken ayları seçersem sorun yok kodlar çalışıyor..

Sub analiz()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("Puantaj")
s1.Range("am5:an65536").ClearContents
For i = 5 To s1.Range("e65536").End(xlUp).Row
If s1.Cells(i, "c") <> "" Then
s1.Cells(i, "am") = s1.Cells(i, "c")
End If
If s1.Cells(i, "c") = "" Then
s1.Cells(i, "am") = s1.Cells(i - 1, "am")
End If
s1.Cells(i, "an") = s1.Cells(i, "am") & s1.Cells(i, "e")
Next i

Set s2 = ThisWorkbook.Worksheets("Bordro")
s2.Range("F6:AG6").ClearContents

sonsüt = 6
For i = 5 To s1.Range("e65536").End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("e5:e" & i), s1.Cells(i, "e")) = 1 Then
s2.Cells(6, sonsüt) = s1.Cells(i, "e")
sonsüt = sonsüt + 1
End If
Next i

aralıkk = s2.Cells(1, 1)
s2.Range("b7:y65536").ClearContents
s2.Range("b7:y65536").Borders.LineStyle = xlNone

sat = 7
For i = 5 To s1.Range("c65536").End(xlUp).Row
If s1.Cells(i, "c") <> "" Then
s2.Cells(sat, "c") = s1.Cells(i, "c")
s2.Cells(sat, "c").Borders.LineStyle = xlNone

sat = sat + aralıkk
End If
Next i

For i = 7 To s2.Range("c65536").End(xlUp).Row
If s2.Cells(i, "c") <> "" Then
For k = 6 To s2.Cells(6, 256).End(xlToLeft).Column
aranan = s2.Cells(i, "c") & s2.Cells(6, k)
sonsat = s1.Range("an65536").End(xlUp).Row
sırası = 0
sırası = WorksheetFunction.Match(aranan, s1.Range("AN1:AN" & sonsat), 0)
If sırası >= 1 Then
s2.Cells(i, k) = s1.Cells(sırası, "aj")
s2.Range("f" & i & ":t" & i).Borders.LineStyle = xlNone


End If
Next k
End If
Next i
    Sheets("EKDERS BORDRO").Select
Application.ScreenUpdating = True
'MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[htsumer]

Hocam hemen hemen bitti sayılır tek bir ricam var sizden
D sütununda ünvanları var b unlarıda makronuza ilave edip Diğer sayfanın E sütununa ilgili karşılıklarına aktarma şansımız varmı?

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[htsumer]

Tam istediğim gibi olmuş..Hocam emeğinize sağlık çok teşekkür ederim. Bunuda hallettik sayenizde..