Verilerin macro ile Çekilmesi ve birleştirilmesi

[ademb28]

Merhaba Üstadlarım,

Data dosyasındaki bilgileri çalışma dosyamdaki veri sayfasına formül ile çekip birleştirme (Birleştir sayfasında) yapıyorum.10 binlerce satır olduğundan formül ile yapıldığında bilgisayarı kasıyor ve zaman alıyor. Makro ile yapılması konusunda yardımlarınızı bekliyorum.Yardımcı olursanız sevinirim.

-Datadan alınan verilerin sırayla veri sayfasına alınarak boş satır ve hücrelerin boş olarak getirilmesi gerekiyor.

saygılarımla,

 

[ademb28]

Yardımlarınızı bekliyorum.Teşekkür ederim

 

[ademb28]

Veri taşımak için aşağıdaki kod işimi görüyor ama 248 satırdan fazlası makroya sığmıyor.
Ek olarak verdiğim data dosyasında satır sayısını kısa tuttum.satır sayısını 60000 den fazla olduğunu düşünürsek makroyu nasıl düzenleyebiliriz?

Bilen arkadaşlardan yardım bekliyorum.

Windows("Data.xls").Activate
Range("A2:L2").Select
Selection.Copy
Windows("Çalışma.xls").Activate
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows("Data.xls").Activate
Range("A3:L3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Çalışma.xls").Activate
Range("E16").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
.
.
.

 

[ademb28]

"Veri taşımak için aşağıdaki kod işimi görüyor ama 248 satırdan fazlası makroya sığmıyor." düzeltiyorum 190 satır

 

[dEdE]

Merhaba,
Aşağıdaki kodu Çalışma isimli dosyanızın Veri sayfasının kod bölümüne yapıştırarak deneyiniz.
Kodlar her iki çalışma kitabının açık olduğu varsayılarak yazılmıştır.

Sub Aktar()
    Set k2 = Workbooks("Data.xls").Sheets("Data")
    satır = 2
    SonSatır = k2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    For i = 2 To SonSatır
        k2.Range("A" & i & ":L" & i).Copy
        Cells(satır, 5).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        satır = satır + 14
    Next
    [A1].Select
End Sub

 

[ademb28]

İlgilendiğiniz için teşekkür ederim dEdE. "Cells(satır, 5).PasteSpecial Paste:=xlPasteAll, Transpose:=True"kodunda hata verdi.

 

[ademb28]

Hocam, Cells(satır, 5).PasteSpecial Paste:=xlPasteAll, Transpose:=True kodunda hata veriyor.1 kez çalışıyor ikinci çalıştırdığımda hata veriyor.Bu sorunuda çözebilirsek sevinirim.

 

[ademb28]

Merhaba,
Aşağıdaki kodu Çalışma isimli dosyanızın Veri sayfasının kod bölümüne yapıştırarak deneyiniz.Kodlar her iki çalışma kitabının açık olduğu varsayılarak yazılmıştır.

Teşekkür ediyorum dEdE.Verdiğin kod çok işime yaradı, emeğine sağlık.İşimin büyük bölümünü halletmiş olduk." Cells(satır, 5).PasteSpecial Paste:=xlPasteAll, Transpose:=True" kod hatasını "Cells(satır, 5).PasteSpecial , Operation:=xlNone, Transpose:=True" şekilde hallettim.

Birleştir kısmı için yardımcı olabilirmisiniz?

 

[dEdE]

Merhaba,
Her iki işlem için aşağıdaki kodu kullanabilirsiniz.

Sub Aktar()
Application.ScreenUpdating = False
    Set k2 = Workbooks("Data.xls").Sheets("Data")
    satır = 2
    SonSatır = k2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    For i = 2 To SonSatır
        k2.Range("A" & i & ":L" & i).Copy
        Cells(satır, 5).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        satır = satır + 14
    Next
    
    For i = 2 To [F65536].End(3).Row
    Sheets("Birleştir").Cells(i, 5).Value = Sheets("Veri").Cells(i, 4).Value & Sheets("Veri").Cells(i, 5).Value & Sheets("Veri").Cells(i, 6).Value
    Next
    [A1].Select
Application.ScreenUpdating = True
End Sub

 

[ademb28]

Merhaba,
Her iki işlem için aşağıdaki kodu kullanabilirsiniz.

Sub Aktar()
Application.ScreenUpdating = False
    Set k2 = Workbooks("Data.xls").Sheets("Data")
    satır = 2
    SonSatır = k2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    For i = 2 To SonSatır
        k2.Range("A" & i & ":L" & i).Copy
        Cells(satır, 5).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        satır = satır + 14
    Next
    
    For i = 2 To [F65536].End(3).Row
    Sheets("Birleştir").Cells(i, 5).Value = Sheets("Veri").Cells(i, 4).Value & Sheets("Veri").Cells(i, 5).Value & Sheets("Veri").Cells(i, 6).Value
    Next
    [A1].Select
Application.ScreenUpdating = True
End Sub

Tek kelimeyle harikasın çok teşekkür ediyorum.Emeğine sağlık.Allah zihin açıklığı versin.Yarın kısmet olursa yüklü dosyama uyarlıyarak deneme yapıcam.sonucu bildiririm.

 

[ademb28]

Merhaba dEdE ellerine sağlık tek kelime ile harika çalışıyor.Allah Razı Olsun.

Son birşey daha isteyebilirmiyim.baştan söylemem gerekirdi ama hallederim diye düşünmüştüm.

örnek=11.482,56 rakam formatını 11482.56 olarak ve 11.482,00 rakam formatını 11482.00 şeklinde makroya yaptırabilirmiyiz.Ben bu çözümü Excel de Araçlar-Seçenekler-Uluslararası ndan ondalık ayracını değiştirerek yapıyorum.Bu durumda bütün çalışma kitapları etkileniyor.

Yardımların için minnettarım.Saygılar

 

[ademb28]

Hocam ondalık sayı ayracını virgül yerine nokta yapmama rağmen birleştir sayfasına taşınan verilerde sayısal olanların ondalık ayracı virgül olarak kalmaktadır.

Yardımlarınızı rica ederim.Şimdiden teşekkür ederim.

 

[ademb28]

Arkadaşlar,

Ondalık ayracını virgül yerine nokta yaptıktan sonra formül ile birleştirme yaptığımda veri sayfasındaki değeri (örnek= 18.10 birleştirmede 18.10) ondalık hanesi nota olarak almakta iken makro ile yapılan birleştirme işleminde (örnek 18.10 birleştirmede 18,10) sayısal değerin ondalık hanesini virgül olarak getirmektedir.

yardımlarınızı rica ediyorum.