Sayfalara dagıt kopyala

[ADER_34]

Merhaba arkadaşlar şöyle bir isteğim olacak yardımcı olurmusunuz,masa üstünde açık olan 4 adet sayfa isimleri değişik, özellikleri xls ve xlsx sabit,sütunlar sabit bu sayfaların "A" sütununda "PART NO" başlığı altındaki satırları alt alta "STOK" adlı çalışma kitabında"SİSTEM RAPOR" sayfasına,sayfaların "A" sütununda "ALL" başlığı altındaki satırları,"STOK" adlı çalışma kitabında"ALLOCADET" adlı sayfaya alt alta kopyalanmasını istiyorum,sayfalar açıkken olacak kolay gelsin teşekkürler..
http://www.dosya.tc/server9/vsc6q1/Sayfalara_kopyala.rar.html

 

[Asri]

Stok dosyasının modul safyasına yapıştırıp deneyiniz.

Açık olan excel dosyalarının kontrol eder. İçinde "Inventory Query" ve "Data List" olan sayfaları birleştirir.

Sub Kayitlari_birlestir()
    Set shsistem = Workbooks("STOK.xlsm").Sheets("SİSTEM RAPOR")
    Set shall = Workbooks("STOK.xlsm").Sheets("ALLOCADET")
    shsistem.Cells.Clear
    shall.Cells.Clear
    
    sistem = 0
   allo = 0
For i = 1 To Workbooks.Count
    Workbooks(i).Activate
    If WorksheetExists("Inventory Query") Then
       Set sh = Sheets("Inventory Query")
       sonsatir = sh.Cells(Rows.Count, "A").End(3).Row
       sonsatirstok = shsistem.Cells(Rows.Count, "A").End(3).Row + 1
       If sistem = 0 Then
          sh.Range("A1:M" & sonsatir).Copy shsistem.Range("A1")
          sistem = 1
       Else
          sh.Range("A2:M" & sonsatir).Copy shsistem.Range("A" & sonsatirstok)
       End If
    End If
    
    If WorksheetExists("Data List") Then
       Set sh = Sheets("Data List")
       sonsatir = sh.Cells(Rows.Count, "A").End(3).Row
       sonsatirstok = shall.Cells(Rows.Count, "A").End(3).Row + 1
       If allo = 0 Then
          sh.Range("A1:M" & sonsatir).Copy shall.Range("A1")
          allo = 1
       Else
          sh.Range("A2:M" & sonsatir).Copy shall.Range("A" & sonsatirstok)
       End If
    End If
   
Next i
    MsgBox ("İşlem tamamlandı")
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(WorksheetName).Name <> "")
   On Error GoTo 0
End Function

 

[ADER_34]

Merhaba sayın asri kodlarınızı denedim ilk çalıştırdığımda şu satırda hata veriyor sonsatir = sh.Cells(Rows.Count, "A").End(3).Row sonra çalışıyor fakat sadece sayfaların "A" sütunu satırlarını aktarıyor ben "A:M" aralığını aktarmasını istiyorum bunu belirtmedim yardımcı olurmusunuz?
1:sonsatir = sh.Cells(Rows.Count, "A").End(3).Row bu kodda debug hatası oluyor
2:"A:M" Sutunlarındaki tüm satırların aktarılmasını istiyorum kolay gelsin teşekkürler..

 

[Asri]

Merhaba sayın asri kodlarınızı denedim ilk çalıştırdığımda şu satırda hata veriyor sonsatir = sh.Cells(Rows.Count, "A").End(3).Row sonra çalışıyor fakat sadece sayfaların "A" sütunu satırlarını aktarıyor ben "A:M" aralığını aktarmasını istiyorum bunu belirtmedim yardımcı olurmusunuz?
1:sonsatir = sh.Cells(Rows.Count, "A").End(3).Row bu kodda debug hatası oluyor
2:"A:M" Sutunlarındaki tüm satırların aktarılmasını istiyorum kolay gelsin teşekkürler..

1- Dosya adları 1 ve 3 olanlarda sayfa adlarının "Inventory Query"
ve dosya adları 2 ve 4 olanlarda sayfa adlarının "Data List" olduğundan emin olun.

2- A2:Mxx olacak şekilde güncellendi.

 

[ADER_34]

Sayın asri dediğiniz gibi sayfa adları doğru fakat şöyle bir durum var,kodlar sayfa 4 seçili iken çalışıyor STOK sayfasında iken aynı satırda hata veriyor, bir de rica etsem çalışma kitap adları adları değişken olursa kodlar nasıl olmalı çünkü hergün serverden aldığım çalışma kitaplarının adları değişik oluyor teşekkürler..

 

[ADER_34]

Merhaba sayın asri sayfa isimlerini 1,2,3,4 olarak kaydedince sorun olmuyor,kodlar sorunsuz.çalışma kitapları 1 ve 3 sayfalarının orginal verilerinde "I" ve "J" "K" "M" sütunlarındaki satırlar metin biçiminde geliyor onları sayı biçiminde olarak nasıl aktarırız? kolay gelsin teşkkürler..

 

[Asri]

Sayın asri dediğiniz gibi sayfa adları doğru fakat şöyle bir durum var,kodlar sayfa 4 seçili iken çalışıyor STOK sayfasında iken aynı satırda hata veriyor, bir de rica etsem çalışma kitap adları adları değişken olursa kodlar nasıl olmalı çünkü hergün serverden aldığım çalışma kitaplarının adları değişik oluyor teşekkürler..

Çalışma kitabı adları değişiyor ise ozaman 1,2,3 ün bir anlamı kalmıyor.
Dosyaların içine bakıp sayfa adlarına göre alıp kopyalamak gerekecek.

 

[Asri]

Kod güncellendi.

 

[ADER_34]

Günaydın sayın asri, kodlar sorunsuz çalışıyor çok teşekkür ederim elinize sağlık..