Listeyi başka kitabın sayfalarına yazdırma

[simetri.]

Merhabalar,

Ekte bulunan Genel adlı kitapta ki listeyi Bayiler adlı kitapta bulunan sayfalara

aktaracak şekilde bir kod gerekli. Değerli ustalarımızdan yardım istiyorum.

Teşekkür ederim.

 

[Orion1]

Dosyanız ektedir.

Sub aktar59()
Dim sat1 As Long, sat2 As Long, sh As Worksheet
sat1 = Cells(Rows.Count, "C").End(xlUp).Row
If sat1 < 3 Then Exit Sub
Application.ScreenUpdating = False
If Workbooks.Open(ThisWorkbook.Path & "\Bayiler.xls").ReadOnly = True Then
    Workbooks("Bayiler.xls").Close True
End If
ThisWorkbook.Activate
For i = 3 To sat1
    Set sh = Workbooks("Bayiler.xls").Sheets(Cells(i, "C").Value)
    sat2 = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row + 1
    sh.Cells(sat2, "B").Value = Cells(i, "D").Value
    sh.Cells(sat2, "C").Value = Cells(i, "F").Value
    sh.Cells(sat2, "D").Value = Cells(i, "G").Value
Next i
Set sh = Nothing
Workbooks("Bayiler.xls").Close True
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[simetri.]

Harika olmuş valla.

Çok teşekkür ederim. Ellerinize sağlık.