• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tablo doldurma

Katılım
3 Ekim 2009
Mesajlar
46
Excel Vers. ve Dili
türkçe
Merhaba,

Sayfa2 de tek sayfa tablo olunca sıkıntı yok ama şuan 3 sayfalık bir tablo olunca doğal olarak tablonun sabit olan üst kısımlarını kodlar siliyor bu araları atlayacak şekilde kodda revize yapabilirmiyiz.

iyi çalışmalar.

Private Sub CommandButton1_Click()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son = 14
s2.Range("b14:k65536").ClearContents
For i = 4 To s1.Range("a65536").End(3).Row
aa = s1.Cells(i, "a").Text
bb = s2.Range("a1").Text
If s1.Cells(i, "a").Text = s2.Range("a1").Text Then
dd = s1.Cells(i, "c").Value
ff = s2.Range("b65536").End(3)(2, 1).Address
s2.Range("b" & son) = s1.Cells(i, "c").Value
s2.Range("c" & son) = s1.Cells(i, "e").Value
s2.Range("d" & son) = s1.Cells(i, "m").Value
s2.Range("e" & son) = s1.Cells(i, "ı").Value
s2.Range("g" & son) = s1.Cells(i, "f").Value
s2.Range("h" & son) = s1.Cells(i, "g").Value
s2.Range("ı" & son) = s1.Cells(i, "l").Value
s2.Range("j" & son) = s1.Cells(i, "h").Value
s2.Range("k" & son) = s1.Cells(i, "j").Value
s2.Range("l" & son) = s1.Cells(i, "k").Value
son = son + 1
End If
Next
End Sub
 

Ekli dosyalar

Merhaba,

arkadaşlar konu hakkında yardımcı olabilecek yok mu?

iyi çalışmalar.
 
Geri
Üst