Veri Aktarma

[emiroglu07]

Üstadlar merhaba excel tablodaki listes sayfasındaki verileri zirve sayfasına aktarmak istiyorum yanlız akatrım şekli zirve sayfasındaki örnek gibi olmalı nasıl bir yol izlemeliyim yanlız excel dosyasını Dosya Aktarma

 

[Ömer]

Merhaba,

Deneyiniz.

Sub Zirve_Aktar()

    Dim S1 As Worksheet, i As Long, sat As Long, j As Byte
    
    Set S1 = Sheets("LİSTE")
    
    Application.ScreenUpdating = False
    Sheets("ZİRVE").Select
    Range("A2:I" & Rows.Count).ClearContents
    
    sat = 2
    For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        
        S1.Cells(i, "A").Resize(1, 5).Copy
        Cells(sat, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        
        Cells(sat, "A") = S1.Cells(i, "H")
        Cells(sat, "H") = S1.Cells(i, "F")
        Cells(sat, "G") = 0
        
        sat = sat + 1
        For j = 9 To 20
            If S1.Cells(i, j) > 0 Then
                Cells(sat, "A") = S1.Cells(2, j)
                Cells(sat, "G") = S1.Cells(i, j)
                Cells(sat, "B") = S1.Cells(i, "A")
                Cells(sat, "C") = S1.Cells(i, "B")
                Cells(sat, "D") = S1.Cells(i, "C")
                Cells(sat, "E") = S1.Cells(i, "D")
                Cells(sat, "F") = S1.Cells(i, "E")
                sat = sat + 1
            End If
        Next j

    Next i
    
    Range("A1").Select
    Application.CutCopyMode = False
    MsgBox "Aktarım Bitti.", vbInformation
    
End Sub

 

[emiroglu07]

Üstad çok güzel olmuş tek bir sıkıntı var işlem görmeyen stunların kayıtları aktarılmasın o nasıl olur

 

[Ömer]

Açıklamanızı destekleyen örnek ekler misiniz.

 

[emiroglu07]

Üstadım yeni eklediğim tabloda zirve sayfasında belirttim orda daha net anlaşılır oldu

 

[emiroglu07]

Aktarma Yeni burada excel

 

[Ömer]

Dosyayı ekleyemediniz sanırım?

 

[emiroglu07]

Dosyayı ekleyemediniz sanırım?

İndirilecek dosya

 

[Ömer]

#2 numaralı mesajdaki kodları güncelledim. Yeniden deneyiniz.

 

[emiroglu07]

Üstad çok teşekkür ederim çok büyük bir dert den kurtardın beni

 

[emiroglu07]

Üstad gene rahatsız ediyorum bir konuda destek isteyecektim Liste sayfasındaki U stunundaki veriyi Zirve Sayfasındaki Alacak stununa kaydetmek istiyorum
Cells(sat, "A") = S1.Cells(i, "H")
Cells(sat, "H") = S1.Cells(i, "F")
Cells(sat, "H") = S1.Cells(i, "U")
Cells(sat, "G") = 0
şeklinde denedim hata verdi nasıl bir yol izlemeliyim