Aktarılan verilerin silinmemesi

[talatcd]

Private Sub CommandButton25_Click() 'liste toplu aktar
Dim aSon As Integer, lst1, w()

Set sf1 = Sheets("Parametre")
Set sf2 = Sheets("Sayfa4")

With sf1
aSon = .Cells(Rows.Count, "A").End(xlUp).Row
lst1 = .Range(.Cells(2, "B"), .Cells(aSon, "F"))
ReDim w(1 To aSon - 1, 1 To 17)
End With

Set dic = CreateObject("Scripting.Dictionary")
For i = 4 To 16
dic.Add sf2.Cells(1, i).Value, i
Next i

With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare

For i = 1 To UBound(lst1)
Key = Trim(lst1(i, 2))

If Not .Exists(Key) Then
say = say + 1
w(say, 1) = say
w(say, 2) = lst1(i, 1)
w(say, 3) = lst1(i, 2)
.Add Key, say
End If
say = .Item(Key)
sut = dic.Item(Trim(lst1(i, 3)))
w(say, sut) = w(say, sut) + lst1(i, 5)
w(say, 17) = w(say, 17) + lst1(i, 5)

Next i
End With

sf2.Select
Range("2:" & Rows.Count).Clear
[a2].Resize(say, 17).Value = w

Set sf1 = Nothing
Set sf2 = Nothing
Erase lst1, w
End Sub

Arkadaşlar bu kodlar verileri parametreden alıp Sayfa4 e aktarıyorum. Parametre sayfasındaki eski veriler aktarıldıktan sonra yeni liste oluşturup aktarmam gerek. Kod Sayfa4 e aktarılmış eski verileri silip Parametredeki yeni verileri aktarıyor. Ben Sayfa4 e aktarılan verilerin silinmemesi, Parametredeki yeni verilerin önce aktarılmış verilerin altına aktarılması.

 

[PLİNT]

Merhaba
Kodlarınızın en son bölümünü
aşağıdaki değiştirip deneyiniz.

'.....kodlarınız
'......
 sf2.Select
[COLOR="Red"]sf2.Range("a" & sf2.Cells(Rows.Count, "A").End(3).Row + 1).Resize(say, 17).Value = w[/COLOR]
Set sf1 = Nothing
Set sf2 = Nothing
Erase lst1, w
End Sub