Bir makroyu çoğaltmak !

[aydgur]

Sub cekaktar2016()
Dim b
Sheets("PORT_R").Select
Range("A2").Select
b = 2
For Each secim In Worksheets("ANASAYFA").Range("A:A")
If secim = "PORT_R" Then
b = Sheets("PORT_R").[A65536].End(3).Row + 1
Worksheets("PORT_R").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("PORT_R").Cells(b, 2) = secim.Offset(0, 2)
Worksheets("PORT_R").Cells(b, 3) = secim.Offset(0, 3)
Worksheets("PORT_R").Cells(b, 4) = secim.Offset(0, 4)
Worksheets("PORT_R").Cells(b, 5) = secim.Offset(0, 5)
Worksheets("PORT_R").Cells(b, 6) = secim.Offset(0, 6)
Worksheets("PORT_R").Cells(b, 7) = secim.Offset(0, 7)
Worksheets("PORT_R").Cells(b, 8) = secim.Offset(0, 8)
Worksheets("PORT_R").Cells(b, 9) = secim.Offset(0, 9)
Worksheets("PORT_R").Cells(b, 10) = secim.Offset(0, 10)
Worksheets("PORT_R").Cells(b, 11) = secim.Offset(0, 11)
Worksheets("PORT_R").Cells(b, 12) = secim.Offset(0, 12)
End If
Next
End Sub
Bu makro ile ANASAYFA adlı sayfadan ( eğer A sütününda PORT_R yazıyorsa )PORT_R sayfasına veri aktarıyorum.
Aynı makronun içine ( eğer A sütününda PORT_K yazıyorsa PORT_K sayfasına aktar gibi nasıl çoğaltabilirim ?

 

[Asri]

Bu şekilde deneyiniz.

Sub cekaktar2016()
   Dim b
   Sheets("ANASAYFA").Select
   anasonsatir = Cells(Rows.Count, "A").End(3).Row
   ensonsutun = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
   For i = 1 To anasonsatir
     port = Worksheets("ANASAYFA").Cells(i, 1).Value
     portsonsatir = Worksheets(port).Cells(Rows.Count, "A").End(3).Row + 1
     For j = 1 To ensonsutun
        Worksheets(port).Cells(portsonsatir, j).Value = Worksheets("ANASAYFA").Cells(i, j).Value
     Next j
   Next i
End Sub