aktarma

[prodigy]

Sub aktar()
Set s1 = Sheets("veri")
Set s2 = Sheets("yedek")
Dim i As Integer
son = Cells(65536, 1).End(xlUp).Row + 2
For i = 4 To son Step 3
deger = Cells(i , 3).Value
sut = WorksheetFunction.CountA(s2.[2:2]) + 1
s2.Range(s2.Cells(2, sut), s2.Cells(2, sut)) = deger
Next i
End Sub
yukarıdaki kod ile veri sayfasında 3 sutundaki bilgileri yedek sayfasına 2. satıra yan yana aktarmakta
bunu yan yana değilde alt alta (sutuna) nasıl aktarabiliriz.

 

[Recep İpek]

Aşağıdaki şekilde deneyiniz.

Sub aktar()
Set s1 = Sheets("veri")
Set s2 = Sheets("yedek")
Dim i As Integer
son = Cells(65536, 1).End(xlUp).Row + 2
For i = 4 To son Step 3
deger = Cells(i, 3).Value
sut = WorksheetFunction.CountA(s2.[b:b]) + 1
s2.Range(s2.Cells(sut, 2), s2.Cells(sut, 2)) = deger
Next i
End Sub

 

[prodigy]

teşekkürler

 

[prodigy]

Sub aktar()
Set s1 = Sheets("veri")
Set s2 = Sheets("yedek")
Dim i As Integer
son = Cells(65536, 1).End(xlUp).Row + 2
For i = 4 To son Step 3
deger = Cells(i, 3).Value
sut = WorksheetFunction.CountA(s2.[b:b]) + 1
s2.Range(s2.Cells(sut, 2), s2.Cells(sut, 2)) = deger
Next i
End Sub
soruyu eksik sorduğumdan bir daha bilgilerinize başvurmak zorunda kaldım. ekteki tabloda personelin adı soyadı, ünvanı ve lojman kesinti miktarlarını sayfa2 nasıl aktarabilirim.

 

[prodigy]

Sub aktar()
Set s1 = Sheets("BORDRO")
Set s2 = Sheets("matrah")
Dim i As Integer
son = Cells(65536, 1).End(xlUp).Row + 2
For i = 4 To son Step 3
loj = Cells(i + 2, 16).Value
adı = Cells(i, 2).Value

If Cells(i + 2, 16).Value = "" Then
GoTo 10
Else
sut = WorksheetFunction.CountA(s2.[a:a]) + 2
sut1 = WorksheetFunction.CountA(s2.[b:b]) + 2
s2.Range(s2.Cells(sut, 1), s2.Cells(sut, 1)) = adı
s2.Range(s2.Cells(sut1, 2), s2.Cells(sut1, 2)) = loj
End If
10:
Next i
End Sub
kendim sordum kendim yaptım