Arkadaşlar Makro Yardım

[aitor]

Arkadaşlar benim yapmak istediğim Sayfa1 de bulunan mesela 100 kişinin benim istediğim sayı kadar Sayfa2'ye, kalan yerden istediğim sayı kadar Sayfa3'e kadar aktarabilmek.
Daha iyi anlaşılısın diye şöyle anlatayım:

Sayfa1 'de 100 kişi bulunsun. Bir hücreye ben mesala 10 gireyim. 10 kişi sayfa 2'ye aktaracak. Sonra 15 gireyim. Bu sefer Sayfa1 'den 11-25. sıradaki kişileri Sayfa3'e aktaracak.

Böyle birşey yapmak istiyorum arkadaşlar. Bu konuda yeniyim.

Yardım ederseniz çok sevinirim...

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub Düğme1_Tıklat()
Dim i As Long, sat As Long
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("A1:A65536").ClearContents
Sheets("Sayfa3").Range("A1:A65536").ClearContents
For i = 1 To Range("C1").Value
    Sheets("Sayfa2").Cells(i, "A").Value = Cells(i, "A").Value
Next
For i = Range("C1").Value + 1 To Range("C1").Value + Range("C2").Value
    sat = sat + 1
    Sheets("Sayfa3").Cells(sat, "A").Value = Cells(i, "A").Value
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[Ayhan Ercan]

anladığım kadarıyla üretmeye çalıştığım çözüm ekteki dosyada.
inceleyiniz.....

Private Sub CommandButton1_Click()
On Error Resume Next
For i = 2 To Sheets.Count
ss = InputBox("Sayfa " & i & "' e", "AKTAR")
Sheets(1).Range("a1:a" & ss).Copy Sheets(i).[a1]
Next
End Sub

 

[aitor]

İlgilenen arkadaşlara teşekkür ederim. Benim tam olarak yapmak istediğim veri aktarımı örneği gönderiyorum. Desteklerini bekliyorum.

 

[Orion1]

Dosyanız ekte.

Sub Düğme1_Tıklat()
Dim i As Long, sat As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("A2:I65536").ClearContents
Sheets("Sayfa3").Range("A2:I65536").ClearContents
sat = 2
sut = 2
For i = 2 To Sheets("Sayfa1").Range("B19").Value + 1
    Sheets("Sayfa2").Cells(sat, sut).Value = Sheets("Sayfa1").Cells(i, "A").Value
    Sheets("Sayfa2").Cells(sat, sut + 1).Value = Sheets("Sayfa1").Cells(i, "B").Value
    sut = sut + 3
    If sut = 8 Then sut = 2: sat = sat + 1
Next
sat = 2
sut = 2
For i = Sheets("Sayfa1").Range("B19").Value + 2 To Sheets("Sayfa1").Range("B19").Value + Sheets("Sayfa1").Range("B20").Value + 1
    Sheets("Sayfa3").Cells(sat, sut).Value = Sheets("Sayfa1").Cells(i, "A").Value
    Sheets("Sayfa3").Cells(sat, sut + 1).Value = Sheets("Sayfa1").Cells(i, "B").Value
    sut = sut + 3
    If sut = 8 Then sut = 2: sat = sat + 1
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub