Sütun ve satır değişkenine göre yeni çalışma sayfası yapmak

[malinois]

Merhaba
Ekli dosyada sheet1 de bulunan ana veri tablosundan çalışma sayfası 2 de bulunan sütun sıralamasıyla (yani ilk sütun c3 sonra c4 en son c5olacak şekilde) ana veri tablosundan ayrı bir çalışma sayfası formül yada makro ile yapılabilir mi? Eğer yapılabilirse yeni sayfada ana veri sayfasından alınan bu 3 ülkede de hiçbir sayı değeri olmayan 7 ve 9. satırlar (sheet1 de bulunan) çıkartılabilir mi? Bu makro ile çözülecekse bu ülke satırının 70 satırlık ve devamlı güncellenen ve bu işleminde günde bir kaç kez (farklı sırlama ve farklı ülkeler ile) yapılması gerektiğini belirtmem gerek. Yardımcı olabilecek tüm arkadaşlara ve ustalara şimdiden teşekkürler.

İstenen son durum çalışma sayfası 3 dedir.

 

[malinois]

Arkadaşlar yardımcı olabilecek olan var mı, bayağıdır uğraşıyorum ama halen çözemedim.

 

[halit3]

Ekli dosyanızı kontrol ediniz.

Sub aktar()

sat = 2
son1 = Worksheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Column - 1
For j = 3 To Worksheets("Sheet1").Cells(Rows.Count, "L").End(3).Row
aranan1 = Sheets("Sheet1").Cells(j, "L").Value
Sheets("Sheet1").Cells(j, "L").Value = WorksheetFunction.Sum(Sheets("Sheet1").Range(Sheets("Sheet1").Cells(j, 2), Sheets("Sheet1").Cells(j, son1)))
Next j
son2 = Worksheets("Sheet1").Cells(Rows.Count, "a").End(3).Row
For j = 2 To Worksheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Column - 1
Sheets("Sheet1").Cells(son2, j).Value = WorksheetFunction.Sum(Sheets("Sheet1").Range(Sheets("Sheet1").Cells(3, j), Sheets("Sheet1").Cells(son2 - 1, j)))
Next j

Sheets("Çalışma Sayfası3").Columns("A:E").ClearContents
For r = 3 To Worksheets("Çalışma Sayfası2").Cells(Rows.Count, "c").End(3).Row
aranan1 = Sheets("Çalışma Sayfası2").Cells(r, "C").Value
For i = 2 To Worksheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Column
aranan2 = Sheets("Sheet1").Cells(2, i).Value
If aranan2 = aranan1 Then
sat1 = 2
For s = 2 To Worksheets("Sheet1").Cells(Rows.Count, i).End(3).Row
If Sheets("Sheet1").Cells(s, "L").Value > 0 Then
Sheets("Çalışma Sayfası3").Cells(sat1, 1).Value = Sheets("Sheet1").Cells(s, 1).Value
Sheets("Çalışma Sayfası3").Cells(sat1, sat).Value = Sheets("Sheet1").Cells(s, i).Value
sat1 = sat1 + 1
End If
Next s
sat = sat + 1
End If
Next i
Next r

sat2 = Worksheets("Çalışma Sayfası3").Cells(2, Columns.Count).End(xlToLeft).Column
For i = 3 To Worksheets("Çalışma Sayfası3").Cells(Rows.Count, "a").End(3).Row
Sheets("Çalışma Sayfası3").Cells(i, sat2 + 1).Value = WorksheetFunction.Sum(Sheets("Çalışma Sayfası3").Range(Sheets("Çalışma Sayfası3").Cells(i, 2), Sheets("Çalışma Sayfası3").Cells(i, sat2)))
Next i
sat3 = Worksheets("Çalışma Sayfası3").Cells(Rows.Count, "a").End(3).Row + 1
For j = 2 To Worksheets("Çalışma Sayfası3").Cells(2, Columns.Count).End(xlToLeft).Column
Sheets("Çalışma Sayfası3").Cells(sat3, j).Value = WorksheetFunction.Sum(Sheets("Çalışma Sayfası3").Range(Sheets("Çalışma Sayfası3").Cells(3, j), Sheets("Çalışma Sayfası3").Cells(sat3, j)))
Next j
Sheets("Çalışma Sayfası3").Cells(2, sat2 + 1).Value = "Grand Total"
Sheets("Çalışma Sayfası3").Cells(sat3, 1).Value = "Grand Total"
MsgBox "işlem tamam"
End Sub

 

[malinois]

Hocam mükemmel olmuş, emeğinize sağlık, çok teşekkür ederim...

 

[halit3]

Hocam mükemmel olmuş, emeğinize sağlık, çok teşekkür ederim...

İyi çalışmalar