Sayfalar arası veri transferi

[excelience]

*merhaba sorum ekte yer almaktadır emekleriniz için teşekkürler

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub özet()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")

sonB = s1.Cells(Rows.Count, "B").End(3).Row
sonD = s1.Cells(Rows.Count, "D").End(3).Row
sonF = s1.Cells(Rows.Count, "F").End(3).Row

sonsat = WorksheetFunction.Max(sonB, sonD, sonF)

s1.Range("B3:G" & sonsat).Copy s2.[B3]

s2.Select
s2.Range("$B$3:$C$" & sonB).RemoveDuplicates Columns:=1, Header:=xlYes
s2.Range("$D$3:$E$" & sonD).RemoveDuplicates Columns:=1, Header:=xlYes
s2.Range("$F$3:$G$" & sonF).RemoveDuplicates Columns:=1, Header:=xlYes

sonB2 = s2.Cells(Rows.Count, "B").End(3).Row
sonD2 = s2.Cells(Rows.Count, "D").End(3).Row
sonF2 = s2.Cells(Rows.Count, "F").End(3).Row

For A = 4 To sonB2
    s2.Cells(A, "C") = WorksheetFunction.SumIf(s1.Range("B3:B" & sonB), s2.Cells(A, "B"), s1.Range("C3:C" & sonB))
Next

For B = 4 To sonD2
    s2.Cells(B, "E") = WorksheetFunction.SumIf(s1.Range("D3:D" & sonD), s2.Cells(B, "D"), s1.Range("E3:E" & sonD))
Next

For C = 4 To sonF2
    s2.Cells(C, "G") = WorksheetFunction.SumIf(s1.Range("F3:F" & sonF), s2.Cells(C, "F"), s1.Range("G3:G" & sonF))
Next


sonsat2 = WorksheetFunction.Max(sonB2, sonD2, sonF2)

s2.Rows(sonsat2 + 1 & ":" & sonsat).Delete

[COLOR="Red"]s2.Range("B3:G" & sonsat2).Borders.LineStyle = xlContinuous[/COLOR]
End Sub

 

[excelience]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub özet()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")

sonB = s1.Cells(Rows.Count, "B").End(3).Row
sonD = s1.Cells(Rows.Count, "D").End(3).Row
sonF = s1.Cells(Rows.Count, "F").End(3).Row

sonsat = WorksheetFunction.Max(sonB, sonD, sonF)

s1.Range("B3:G" & sonsat).Copy s2.[B3]

s2.Select
s2.Range("$B$3:$C$" & sonB).RemoveDuplicates Columns:=1, Header:=xlYes
s2.Range("$D$3:$E$" & sonD).RemoveDuplicates Columns:=1, Header:=xlYes
s2.Range("$F$3:$G$" & sonF).RemoveDuplicates Columns:=1, Header:=xlYes

sonB2 = s2.Cells(Rows.Count, "B").End(3).Row
sonD2 = s2.Cells(Rows.Count, "D").End(3).Row
sonF2 = s2.Cells(Rows.Count, "F").End(3).Row

For A = 4 To sonB2
    s2.Cells(A, "C") = WorksheetFunction.SumIf(s1.Range("B3:B" & sonB), s2.Cells(A, "B"), s1.Range("C3:C" & sonB))
Next

For B = 4 To sonD2
    s2.Cells(B, "E") = WorksheetFunction.SumIf(s1.Range("D3:D" & sonD), s2.Cells(B, "D"), s1.Range("E3:E" & sonD))
Next

For C = 4 To sonF2
    s2.Cells(C, "G") = WorksheetFunction.SumIf(s1.Range("F3:F" & sonF), s2.Cells(C, "F"), s1.Range("G3:G" & sonF))
Next


sonsat2 = WorksheetFunction.Max(sonB2, sonD2, sonF2)

s2.Rows(sonsat2 + 1 & ":" & sonsat).Delete

[COLOR="Red"]s2.Range("B3:G" & sonsat2).Borders.LineStyle = xlContinuous[/COLOR]
End Sub

:???:

:bravo::bravo::bravo::bravo::bravo::bravo::bravo::bravo::bravo::bravo:

ÇOK TEŞEKKÜR EDERİM HOCAM