- Katılım
- 24 Kasım 2007
- Mesajlar
- 769
- Excel Vers. ve Dili
- Office 365 - Türkçe
- Altın Üyelik Bitiş Tarihi
- 30-01-2024
Merhaba aşağıdaki kodu kullanarak "sayfa10" dan diğer sayfalara veri aktarıyorum. Verileri dolu hücrenin altına yapıştırıyor. Buraya kadar bir şey yok.
Yaptığım dosyada ;
B48 nolu hücre dolu hücre
B49 nolu hücre boş ve ben bu hücreye filitre olarak kullanıyorum
Makro B49 nolu hücreye verileri yapıştırıyor. B49'u yapıştırmadan geçmesi için ; B50 boş ise buraya yapıştır değilse B50'den sonraki dolu satırın altına yapıştır
Yaptığım dosyada ;
B48 nolu hücre dolu hücre
B49 nolu hücre boş ve ben bu hücreye filitre olarak kullanıyorum
Makro B49 nolu hücreye verileri yapıştırıyor. B49'u yapıştırmadan geçmesi için ; B50 boş ise buraya yapıştır değilse B50'den sonraki dolu satırın altına yapıştır
Kod:
Option Compare Text
Sub Aktar()
Dim i%, a%, son%
With Sayfa10
For i = 1 To Sheets.Count 'Aktarma yapılacak sayfa numaraları
For a = 5 To .Range("C35").End(3).Row 'Aktarılacak sayfa numaralarının bulunduğu aralık
If .Cells(a, 2).Value = CStr(Sheets(i).Name) Then 'Eğer aktarılacak sayfa numaraları ile ana sayfadaki numaralar tutuyorsa aktar şartı
son = Sheets(i).Range("B65536").End(3).Row + 1 'Hangi dolu hücrenin altına aktarma yapılacak
Sheets(i).Cells(son, 2) = .Cells(a, 3).Value 'Giris sayfanın 3 sütununu, aktarılacak sayfanın 2 sütununa aktar
Sheets(i).Cells(son, 3) = .Cells(a, 4).Value
Sheets(i).Cells(son, 4) = .Cells(a, 5).Value
Sheets(i).Cells(son, 5) = .Cells(a, 6).Value
End If
Next a
Next i
End With
son = Empty: i = Empty: a = Empty
End Sub