satır kopyalayarak veri toplama

[albatros01]

Arkadaşlar Merhaba,
60 sayfalık bir çalışma kitabında sorgulama yapıp bulunan değerleri ve değerlerin bulunduğu satırlarlardaki bilgileri bir sayfaya toplamam gerekiyor. Örnek dosya ekliyorum yardımcı olursanız sevinirim

 

[albatros01]

arkadaşlar yardım edecek kimse yok mu

 

[albatros01]

çok mu zor bir konu bilmiyorum ama çözüm makro kursuna gitmek galiba

 

[parametre]

verdiginiz bilgiler yetersiz ne istediginizi tam ve net anlatınız kendiniz anlayabileceğiniz şekilde değil

 

[albatros01]

öncelikle ilgilendiğiniz için teşekkür ederim. Kısaca anlatmaya çalışayım elimde sorgulamam gereken 150 şerli gruplar halinde 5000 e yakın müşteri numaraları var. bu 60 çalışma sayfası içinde müşterilerin farklı dönemdeki bilgileri mevcut. Bu müşterilerin farklı dönemleredeki kayıtlı bilgilerini her 150 kilişik grup için tek sayfada toplamam gerekiyor. 1 müşterinin bir sayfada 4-5 satır bilgisi olduğu gibi 4-5 ayrı sayfada da bilgisi olabiliyor. Benim istediğim arama yaptığım müşteriye ait numaranın bulunduğu diğer sayfalardaki satırları bir sayfada toplamak. Bu işlemi 150 şerli gruplar halinde yapmak. 150 tane müşterinin numarasını girip makroyu çalıştırınca bu numaraların karşılık geldiği sayfalardaki bilgilerin ayrı bir sayfada toplanması. Arama sonucunda bu 150 kişilik gurupta çalışma sayfalarında bilgisi olamayan müşteri numaralarınında başka bir sayfada bulunamayanlar olarak kaydedilmesi. Teşekkür ederim.

 

[albatros01]

yardım lütfen

 

[aphemeira]

Sub veritoplama()
sayfasayisi = Sheets.Count
For i = 2 To sayfasayisi
Sheets(i).Select
Range("a2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(1).Select
satirsayisi = Range("a1").CurrentRegion.EntireRow.Count
Cells(satirsayisi + 1, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next i
Cells.Select
Cells.EntireColumn.AutoFit
Range("a1").Select

sayfaadi = ActiveSheet.Name
Sheets(sayfaadi).Copy
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" & sayfaadi & ".xlsx"
End Sub



'umarım işine yarar