DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub AKTAR()
Set S1 = Sheets("ELDEKİ LİSTE")
Set S2 = Sheets("SONUÇ")
S1.Select
S2.[A2:F65536].Clear
SATIR = 2
For X = 2 To 8 Step 3
For Y = 2 To S1.Cells(65536, X).End(3).Row
S2.Cells(SATIR, 1) = S1.Cells(1, X)
S2.Cells(SATIR, 2) = S1.Cells(Y, X)
S2.Cells(SATIR, 3) = S1.Cells(Y, X + 1)
S2.Cells(SATIR, 4) = S1.Cells(Y, X + 2)
If X = 8 Then
S2.Cells(SATIR, 5) = S1.Cells(Y, X + 3)
S2.Cells(SATIR, 6) = S1.Cells(Y, X + 4)
End If
SATIR = SATIR + 1
Next
Next
Set S1 = Nothing
Set S2 = Nothing
MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub
Elbette var, örnek dosya ne ise, o. Aynı dosyaya uyguladım bir buton ile.Kod:Set S2 = Sheets("SONUÇ")SONUÇ isminde sayfanız varmı?Kod:Set S1 = Sheets("ELDEKİ LİSTE")
Veya ELDEKİ LİSTE isminde sayfa varmı?