Rapordan tablo yapma lütfen yardımm...

[tırıvırıtır]

Öncelikle iyi günler diliyorum.

Elimde bir programdan çekilmiş büyük bir data var. Buradaki raporda birleştirilmiş hücrelerle gruplandırmalar yapılmış. İlk olarak birleştirilmiş hücreleri çözdüm. Ancak, bu haliyle pivot yapamadığım için bu verileri düzgün hale getirmem gerekiyor. Makro yazarak yapmaya çalıştım ama kodu çalıştıramıyorum.

Koddaki eksiklik nedir acaba? Yardımcı olabilirseniz çok sevinirim. Örnek olsun diye raporun küçük bir parçasını yolluyorum.

Yardımlarınız için şimdiden çok teşekkür ederim.

 

[omerceri]

Dosyanızı yedekleyin aşağıdaki ki kodu deneyin bilgiler 2. sayfaya aktarıyor..

Sub XX()
say = Sheets("Sayfa1").Range("g65536").End(xlUp).Row - 2
Sheets("Sayfa2").Range("a1").Value = "Kategori"
Sheets("Sayfa2").Range("b1").Value = "Kategori Ana Grup No"
Sheets("Sayfa2").Range("c1").Value = "Metrics"
Sheets("Sayfa2").Range("e1").Value = "Satis miktari"
Sheets("Sayfa2").Range("f1").Value = "KgLt"
Sheets("Sayfa1").Range("b3:g" & say).Copy
Sheets("Sayfa2").Range("a2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  Sheets("Sayfa2").Columns("D:D").Delete Shift:=xlToLeft
 Sheets("Sayfa2").Range("A1").AutoFilter Field:=2, Criteria1:="Total"
 Sheets("Sayfa2").Range("a2:e65536").EntireRow.Delete
 Sheets("Sayfa2").Range("A1").AutoFilter
End Sub

 

[tırıvırıtır]

Ömer Bey elinize sağlık.

ancak kendi formülasyonumdaki hatayı da buldum.. ( belki benzer problemi yaşayanlara faydası olur) Olması gereken;

Sub Makro1()

Dim i As Integer
Dim k As Integer

For i = 4 To 25000
For k = 1 To 3

If Cells(i, k).Value = "" Then
Cells(i - 1, k).Copy
Cells(i, k).PasteSpecial xlPasteValues
End If
If Cells(i, k).Value <> "" Then
End If

Next i
Next k

End Sub

bu kodu birleştirilmiş sütunları çözdükten sonra yazınca oluyor. Ancak dosya büyük olduğu için 54144 e kadar uygulayamıyor. Bölüm bölüm yapmak lazım.

Tekrar emeğinize sağlık...