- Katılım
- 29 Ekim 2010
- Mesajlar
- 12
- Excel Vers. ve Dili
- exel 2003
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub taşı()
For i = 2 To Cells(Rows.Count, 1).End(3).Row
sonsat = Sheets(Cells(i, 2).Value).Cells(Rows.Count, 1).End(3).Row + 1
Range("A" & i & ":J" & i).Copy Destination:=Sheets(Cells(i, 2).Value).Range("A" & sonsat & ":J" & sonsat)
Next i
End Sub
kodları nasıl deneyeceğim yardım ederseniz sevinirim
eline sağlık
hocam butona bastığımda aktarıyor fakat tekrar bastığımda ikinci sefer de kopyalayarak aktarıyor işlemi iki sefer aktarıyo
aktarılan işlemi bir daha aktarmasa olmaz mı
şimdiden teşekkürler
Sub taşı()
For i = 2 To Cells(Rows.Count, 1).End(3).Row
sonsat = Sheets(Cells(i, 2).Value).Cells(Rows.Count, 1).End(3).Row + 1
If Cells(i, 11).Value <> "Aktarıldı" Then
Cells(i, 11).Value = "Aktarıldı"
Range("A" & i & ":J" & i).Copy Destination:=Sheets(Cells(i, 2).Value).Range("A" & sonsat & ":J" & sonsat)
End If
Next i
End Sub
Sub taşı2()
For a = 2 To Sheets.Count
Sheets(a).Range("A2:A65536").ClearContents
Next
For i = 2 To Cells(Rows.Count, 1).End(3).Row
sonsat = Sheets(Cells(i, 2).Value).Cells(Rows.Count, 1).End(3).Row + 1
Range("A" & i & ":J" & i).Copy Destination:=Sheets(Cells(i, 2).Value).Range("A" & sonsat & ":J" & sonsat)
Next i
End Sub