tablo düzenleme

[umudum80]

Arkadaşlar merhaba

Tablo yapma konusunda engin fikirlerinize ihtiyacım var. Linkte paylaştıgım tabloda iki sheet var. tablo adlı sheet teki verileri yapılmasını istediğim adlı sheet e eklemek ıstıyorum.
Konu hakkında değerli yardımlarınız için şimdiden çok teşekkur ederim.

https://s2.dosya.tc/server25/hg7db9/TABLO.xlsx.html

 

[bmutlu966]

Deneyiniz.

Sub duzenle()

son = [G65000].End(3).Row
Range("A1:BG65000").UnMerge
Columns("A:BD").ColumnWidth = 9
For t = son To 16 Step -1

If Cells(t, "G") = "" And Cells(t, "S") = "" Then
    Rows(t).Delete
End If

Next

For t = 16 To son

If Cells(t, "I") = "" Then
    Cells(t, "I") = Cells(t - 1, "I")
    Cells(t, "O") = Cells(t - 1, "O")
    Cells(t, "S") = Cells(t - 1, "S")
End If

Next

 Columns("A:F").Delete Shift:=xlToLeft
    Columns("B:B").Delete Shift:=xlToLeft
    Columns("C:G").Delete Shift:=xlToLeft
    Columns("D:D").Delete Shift:=xlToLeft
    Columns("E:E").Delete Shift:=xlToLeft
    Columns("F:L").Delete Shift:=xlToLeft
    Columns("G:K").Delete Shift:=xlToLeft
    Columns("H:L").Delete Shift:=xlToLeft
    Columns("I:N").Delete Shift:=xlToLeft
    Columns("J:U").Delete Shift:=xlToLeft

Range("A15") = "Barkod"
Range("B15") = "Seri No"
Range("C15") = "Tarih"
Range("D15") = "Ürün"
Range("E15") = "Cari kodu-Ünvani"
Range("F15") = "Rakam 1"
Range("G15") = "Adet"
Range("H15") = "Rakam 2"
Range("I15") = "Rakam 3"

son = [B65000].End(3).Row
For t = son To 2 Step -1

If Cells(t, "G") = "" Then
    Rows(t).Delete
End If

Next

 Columns("E:E").Select
    Selection.Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 33.86
 Columns("D:D").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
Range("A2").Select
End Sub

 

[umudum80]

Merhabalar bmutlu bey
Denedim ama olmadı sadece baslıklar gelıyor ürünler gelmıyor tekrar bakma sansınız varmı

 

[bmutlu966]

Dosyadaki tuşa basıp birkaç saniye bekleyin. Tablonuz düzenlenecektir.

https://s2.dosya.tc/server25/zj6x7s/TABLO.xlsm.html

 

[umudum80]

Çok teşekkur ederım elinize emeğinize sağlık süper olmuş

 

[Necdet]

Merhaba,
Alternatif olsun.

Public Sub Duzenle()

Dim arr As Variant, _
    i   As Long, _
    j   As Long, _
    tar As Date, _
    unv As String, _
    sno As String

arr = Sayfa1.UsedRange.Value
Sayfa2.Range("A1").CurrentRegion.Offset(1).ClearContents

For i = 15 To UBound(arr, 1)
    If arr(i, 4) Like "MARKET*" Then
        tar = arr(i, 15)
        unv = arr(i, 19)
        sno = arr(i, 9)
    End If
    
    If arr(i, 7) <> "" Then
        j = j + 1
        arr(j, 1) = unv
        arr(j, 2) = tar
        arr(j, 3) = sno
        arr(j, 4) = arr(i, 7)
        arr(j, 5) = arr(i, 17)
        arr(j, 6) = arr(i, 27)
        arr(j, 7) = arr(i, 33)
        arr(j, 8) = arr(i, 39)
        arr(j, 9) = arr(i, 46)
     End If
Next i

Sayfa2.Range("A2").Resize(j, 9) = arr

End Sub