DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub aktar()
For i = 2 To [a65536].End(xlUp).Row
If WorksheetFunction.CountIf(Range("a2:a" & [a65536].End(xlUp).Row), Cells(i, 1)) = 1 Then
Cells(i, 1).Select
Selection.Cut
Sheets("sheet2").Select
a = Sheets("sheet2").[a1].End(xlDown).Row
If [a2] = "" Then
[a2].Select
Else
Cells(a + 1, 1).Select
End If
ActiveSheet.Paste
Sheets("sheet1 (2)").Select
End If
Next
End Sub
Yusuf44 bey benimde benzer bir sorunum var sanırım sadece hücrelerin yerleri farklı eğer yardımcı olabilirseniz çok sevinirim ekte gönderdiğim formda işaretli hücrelere girilen bilgileri sheet 2 ye alt alta listemek istiyorum şimdiden teşekürler.
Sub aktar()
Set s1 = Sheets("sheet1")
Set s2 = Sheets("sheet2")
s2.Select
a = s2.[b65536].End(xlUp).Row
s2.Range("B" & a + 1) = s1.[d3]
s2.Range("c" & a + 1) = s1.[e4]
s2.Range("d" & a + 1) = s1.[e6]
s2.Range("e" & a + 1) = s1.[e7]
s2.Range("f" & a + 1) = s1.[e8]
s2.Range("g" & a + 1) = s1.[e9]
s2.Range("h" & a + 1) = s1.[e10]
s1.Select
[d3:d9] = ""
[d3].Select
End Sub