dolu verileri diğer sayfaya gönderme ?

[fildekoz]

Merhaba Arkadaşlar.

sayfa1 deki genel toplamda ücret olan verileri, sayfa 2 ye makro ile nasıl gönderebilrim ?

yardımlarınız için şimdiden tşk ederim.

 

[fildekoz]

Yardımlarınızı rica ederim..

 

[fildekoz]

Yardımlarınızı rica ederim..

 

[İhsan Tank]

Merhaba Arkadaşlar.

sayfa1 deki genel toplamda ücret olan verileri, sayfa 2 ye makro ile nasıl gönderebilrim ?

yardımlarınız için şimdiden tşk ederim.

Merhaba
Boş bir module kopyalayın ve deneyin

Option Explicit
Sub ücretli_aktar_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim s1, s2
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
trabzonspor = MsgBox("Ücreti Olanları Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
s2.Range("A5:N65536").ClearContents
kaplan = 5
For ts = 5 To s1.Cells(Rows.Count, "A").End(xlUp).Row
If s1.Cells(ts, "J") <> 0 Then
s2.Cells(kaplan, "A") = s1.Cells(ts, "A")
s2.Cells(kaplan, "B") = s1.Cells(ts, "B")
s2.Cells(kaplan, "C") = s1.Cells(ts, "C")
s2.Cells(kaplan, "D") = s1.Cells(ts, "D")
s2.Cells(kaplan, "E") = s1.Cells(ts, "E")
s2.Cells(kaplan, "F") = s1.Cells(ts, "F")
s2.Cells(kaplan, "G") = s1.Cells(ts, "G")
s2.Cells(kaplan, "H") = s1.Cells(ts, "H")
s2.Cells(kaplan, "I") = s1.Cells(ts, "I")
s2.Cells(kaplan, "J") = s1.Cells(ts, "J")
s2.Cells(kaplan, "L") = s1.Cells(ts, "L")
s2.Cells(kaplan, "M") = s1.Cells(ts, "M")
s2.Cells(kaplan, "N") = s1.Cells(ts, "N")
kaplan = kaplan + 1
End If
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Ücretlileri Aktardım", , "Bitiş"
End Sub

 

[fildekoz]

ihsan Bey;

yardımlarınız için çook tşk ederim. istediğim gibi olmuş. yalnız birşey daha sormak istiyorum. sayfa 2 ye aktarırken, değerlerini kopyalıyor. hücreleri kenarlıklarıyla birlikte nasıl kopyalatabiliriz.?

 

[İhsan Tank]

ihsan Bey;

yardımlarınız için çook tşk ederim. istediğim gibi olmuş. yalnız birşey daha sormak istiyorum. sayfa 2 ye aktarırken, değerlerini kopyalıyor. hücreleri kenarlıklarıyla birlikte nasıl kopyalatabiliriz.?

Verileri Alması daha doğru olduğu için öyle yapmıştım. Siz çizgilerin de mi olmasını istiyorsunuz onu mu anlamalıyım.

 

[fildekoz]

Doğrudur İhsan Bey;

çizgileriyle birlikte alması gerekiyor. bunu bir fatura yazdırmada kullanacağım. ilgili kalemlerin aynı formatta diğer sayfaya aktarılması gerekiyor..

 

[İhsan Tank]

Doğrudur İhsan Bey;

çizgileriyle birlikte alması gerekiyor. bunu bir fatura yazdırmada kullanacağım. ilgili kalemlerin aynı formatta diğer sayfaya aktarılması gerekiyor..

Merhaba
Kodu bununla değiştirir misiniz_?

Sub ücret_aktar_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim s1, s2
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
trabzonspor = MsgBox("Ücreti Olanları Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
ts = s1.Range("A65536").End(xlUp).Row
s1.Range("A5:N" & ts).Copy Destination:=s2.Range("A5")
For ts = s2.Cells(Rows.Count, "A").End(xlUp).Row To 5 Step -1
If s2.Cells(ts, "J") = 0 Then
s2.Rows(ts).Delete
End If
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Ücretlileri Aktardım", , "Bitiş"
End Sub

 

[fildekoz]

İhsan Bey;
Allah razı olsun.. Elleriniz dert görmesin. çok güzel oldu....
teşekkür ederim...

 

[İhsan Tank]

İhsan Bey;
Allah razı olsun.. Elleriniz dert görmesin. çok güzel oldu....
teşekkür ederim...

Rica ederim
Allah sizden de razı olsun
:keyif: