Soru SAYFA1' DEN SAYFA2' YE VERİ AKTARIMI

[hamza2011]

Merhaba ;

Ek' li dosyada sizlere bir konuyu arz etmeye çalıştım. Konu hakkında yardımlarınıza ihtiyacım var.

 

[çıtır]

Deneyiniz.

Sub egıt()
Dim s1 As Worksheet: Dim s2 As Worksheet
Dim i As Integer
Set s1 = Sheets("Sayfa1"): Set s2 = Sheets("Sayfa2"): Set wfs = WorksheetFunction
Application.ScreenUpdating = False
Sonkolon = s1.Cells(5, Columns.Count).End(xlToLeft).Column
s2.Select
t1 = s2.UsedRange.Rows.Count
t2 = s2.UsedRange.Columns.Count
s2.Range(s2.Cells(5, 2), s2.Cells(t1, t2)).Select
Selection.ClearContents
son = s1.Cells(65336, "B").End(3).Row
süt = 6
s1.Select
s1.Range("B5" & ":" & "E" & son).Select
Selection.Copy
s2.Select
s2.Range("B5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
For y = 7 To son
For i = 6 To Sonkolon
bak = s1.Cells(5, i)
If Left(bak, 2) = "CU" And wfs.CountIf(s1.Range(s1.Cells(5, 6), s1.Cells(5, Sonkolon)), s1.Cells(5, i)) = 1 And s1.Cells(y, i) = "" Then
s2.Cells(y, süt) = s1.Cells(5, i)
süt = süt + 1
End If
Next i
süt = 6
Next y
s2.Range("B5").Select
Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAM", vbInformation, "BİLGİ"
End Sub

 

[hamza2011]

HOCAM ÖNCELİKLE TEŞEKKÜR EDERİM;

ASILDA OLMASI GEREN YANİ EKSİK EĞİTİM KODLARININ ADETLERİNİ ŞU HALDEKİ (siz göresiniz diye, sonra silinebilir) "F" SÜTUNUNA ÇIKARTTIM. VE BU MAKRO İLE YAZDIĞINIZ EKSİK EĞİTİM KODLARI DA ADET OLARAK "G" SÜTUNUNDADIR. DOLAYISIYLA ŞU HALDE MAKRO OLMASI GEREKEN "F" SÜTUNUNDAKİ ADETLERİ VERMİYOR.

TEKRAR İLGİLENEBİLİR MİSİNİZ LÜTFEN!

 

[çıtır]

Sayın hamza2011 ben bir eksiklik bulamadım.Kodu uyguladığım dosyayı ekliyorum.Dönüş yaptığınız için teşekkür ederim.Lütfen forumdaki yazılarınızda küçük harf kullanınız.