Çözüldü Excel Satır Atlayarak Kopyalama

Katılım
3 Ocak 2019
Mesajlar
14
Excel Vers. ve Dili
2016 TR
Merhaba Arkadaşlar bir sorun yaşıyorum ;




Şöyle bir tablom var bundaki değerleri şuradan çekiyorum ;




Bu formül aynı şekilde 1002-1003 diye devam ediyor fakat formülü kopyaladığım zaman bir satır alttaki 1002 yerine 1018'i alıyor nasıl düzeltebilirim ?

Dosya burada : http://s7.dosya.tc/server12/qbrmdp/EXCEL.xlsx.html
 
Son düzenleme:
Katılım
3 Ocak 2019
Mesajlar
14
Excel Vers. ve Dili
2016 TR

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,614
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub kopyalaCevir()
    [w:ae].ClearContents
    Dim w(1 To 17, 1 To 9)
    w(1, 2) = "Linear Add"
    w(1, 3) = "No"
    w(1, 6) = "None"
    w(1, 7) = "None"
    w(1, 8) = "None"
    w(1, 9) = "None"
    For i = 1 To 17
        w(i, 4) = Cells(4, i + 4)
    Next i
   
    ySat = 5
    For sat = 5 To Cells(Rows.Count, "C").End(3).Row
        If Cells(sat, "C") <> "" Then
            w(1, 1) = Cells(sat, "C")
            For i = 1 To 17
                w(i, 5) = Val(Cells(sat, i + 4))
            Next i
        End If
   
        Cells(ySat, "W").Resize(17, 9).Value = w
    ySat = ySat + 19
    Next sat

End Sub
 

yanginci34

Altın Üye
Katılım
6 Temmuz 2010
Mesajlar
1,592
Excel Vers. ve Dili
excel2016
Altın Üyelik Bitiş Tarihi
12-10-2026
Hocam başka bir arkadaş macro ile sorunumu tam olarak çözdü. Sizinde elinize sağlık uğraşıp yapmışsınız yinede. Teşekkür ederim
Rica etsem dosyanızın macro kodlarını burada paylaşabilirmisiniz.
 
Katılım
3 Ocak 2019
Mesajlar
14
Excel Vers. ve Dili
2016 TR
Rica etsem dosyanızın macro kodlarını burada paylaşabilirmisiniz.
Buyrun

Kod:
Sub Stadia()
    Dim i&, son&
    Sayfa2.Cells.Clear
    For i = 3 To Sayfa1.Range("B65536").End(3).Row
        With Sayfa2
            son = .Range("D65536").End(3).Row
            .Cells(son, 1) = Sayfa1.Cells(i, 2).Value
            .Cells(son, 2) = "Linear Add"
            .Cells(son, 3) = "No"
            Sayfa1.Range("D2:T2").Copy
            .Range("D" & son).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Sayfa1.Range("D" & i & ":T" & i).Copy
            .Range("E" & son).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            .Cells(son, 6) = "None"
            .Cells(son, 7) = "None"
            .Cells(son, 8) = "None"
            son = son + 17
        End With
    Next i
    Sayfa2.Activate
    Sayfa2.Cells.ClearFormats
    i = Empty: son = Empty
    MsgBox "İşlem Tamamlandı.", vbInformation, " "
End Sub
 

yanginci34

Altın Üye
Katılım
6 Temmuz 2010
Mesajlar
1,592
Excel Vers. ve Dili
excel2016
Altın Üyelik Bitiş Tarihi
12-10-2026
Teşekkürler
 

yanginci34

Altın Üye
Katılım
6 Temmuz 2010
Mesajlar
1,592
Excel Vers. ve Dili
excel2016
Altın Üyelik Bitiş Tarihi
12-10-2026
Alternatif olarak bende birşeyler yapmaya çalıştım denermisiniz.
 

Ekli dosyalar

Üst