Range Sınıfının PasteSpecial Yöntemi Başarısız.

[ahmed_ummu]

Merhaba arkadaşlar.

Aşağıdaki kodları çalıştırınca "Range Sınıfının PasteSpecial Yöntemi Başarısız." hatası alıyorum. Listbox4 den seçilen kapalı dosyayı açıp, A2:AK sütunlarındaki veriyi B sütununu baz alarak en son dolu satıra kadar kopyalayıp, SÖP sayfasının B7 den başlayıp, ilk boş satırından itibaren yapıştıracak. Kırmızı satırı seçip, konu başlığında belirtiğim hatayı veriyor. Rica etsem bakabilir misiniz.

Application.Workbooks.Open "C:\Users\" & Environ("UserName") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.Value
dosya_adi = ListBox4.Value
Dim say As Integer
Dim Sayfa As Worksheet
Set Sayfa = Worksheets("dışarıstj")
say = Sayfa.Cells(Sayfa.Rows.Count, "B").End(xlUp).Row
Sayfa.Range("a2:Ak" & say).Copy
Application.Workbooks(dosya_adi).Close SaveChanges:=True

Sheets("SÖP").Select
Range("b7").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.PasteSpecial Paste:=xlValues
Label592.Enabled = False

 

[Muzaffer Ali]

Merhaba.

1- Kopyalanan hücreler yada yapıştırılan hücreler birleştiriliş hücre olabilir.
2- Yapıştırılacak hücrelerin sayfası koruması olabilir.

Kontrol edin.

Yada dosyanızı ekleyin farklı bir sorun varsa kontrol edelim.

 

[ahmed_ummu]

Merhaba.

1- Kopyalanan hücreler yada yapıştırılan hücreler birleştiriliş hücre olabilir.
2- Yapıştırılacak hücrelerin sayfası koruması olabilir.

Kontrol edin.

Yada dosyanızı ekleyin farklı bir sorun varsa kontrol edelim.

Muzaffer Ali bey her ikisi de kopyalanan ve yapıştırılan hücreler birleştirilmiş hücre değil. Sayfa koruması da yok. Dosyamın boyutu biraz büyük. Bir örnek dosya hazırlayıp göndereyim.

 

[ahmed_ummu]

ActiveCell.PasteSpecial Paste:=xlValues satırı Sayfa.Range("a2:Ak" & say).Copy satırından sonra gelmeli araya başka kodlar girmemeli diye değerlendiriyorum.

Sayın dEdE Sayfa.Range("a2:Ak" & say).Copy kapalı bir dosyadan alınıyor. Yapıştırılan sayfa ise aktif dosyada bir sayfa ve ilk boş satır bulunup ilk boş satırdan itibaren yapıştırılması gerekiyor. 150'ye yakın kapalı dosyadan veriler alınıp (Bu dosyaların biçimleri hep aynı ve aynı sütun aralığından alınıyor veriler. Satır sayısı değişkenlik gösterebiliyor. Bir dosyadan 2 satır alıyorsak başka bir doyadan 10 satırlık veri alınabiliyor.)

 

[ahmed_ummu]

Muzaffer Ali bey her ikisi de kopyalanan ve yapıştırılan hücreler birleştirilmiş hücre değil. Sayfa koruması da yok. Dosyamın boyutu biraz büyük. Bir örnek dosya hazırlayıp göndereyim.

Merhaba Muzaffer Ali bey.


Örnek dosya hazırlayıp onu gönderecektim ama çok zaman alacağı için kendi dosyamı gönderiyorum. A_MUHASEBE_OKUL_BÜRO_64_32 Excel dosyası çalışma kitabı. VBa şifresi 14539966

Userform41 de listboxa gelen dosyalar kapalı dosya. Listboxtan dosya ismi seçip "seçili okulun staj günlerini yükle" butonuna tıklandığında Açılan dosyadan belirtilen aralığı kopyalayıp, çalışma kitabındaki "SÖP" sayfasının B sütunu baz alınarak ilk boş satırdan itibaren yapıştıracak. 150'ye yakın kapalı dosya var. Her bir dosyanın verileri yapıştırılırken, b sütunu baz alınıp ilk boş satırdan itibaren yapıştıracak. STAJYER_ÖĞRENCİ_PUANTAJLARI klasörü masaüstünde olacak. Yardımcı olursanız çok sevinirim. Biraz karışık ama İnşallah anlatabilmişimdir.

 

[Muzaffer Ali]

Aşağıdaki kodu kullanın

Private Sub Label592_Click()
    Dim Say As Long
    Dim Sayfa As Worksheet
    Dim SonSatir As Long
   
    Application.Workbooks.Open Environ("UserProfile") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.Value
   
    Set Sayfa = Worksheets("dışarıstj")
    Say = Sayfa.Cells(Sayfa.Rows.Count, "B").End(xlUp).Row
    Sayfa.Range("A2:Ak" & Say).Copy
   
    With ThisWorkbook.Worksheets("SÖP")
        SonSatir = .Cells(Rows.Count, "B").End(xlUp).Row + 1
        .Cells(SonSatir, "B").PasteSpecial Paste:=xlValues
    End With
   
    Application.DisplayAlerts = False
    Sayfa.Parent.Close SaveChanges:=True
    Application.DisplayAlerts = True
    Label592.Enabled = False
End Sub

 

[ahmed_ummu]

Aşağıdaki kodu kullanın

Private Sub Label592_Click()
    Dim Say As Long
    Dim Sayfa As Worksheet
    Dim SonSatir As Long
  
    Application.Workbooks.Open Environ("UserProfile") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.Value
  
    Set Sayfa = Worksheets("dışarıstj")
    Say = Sayfa.Cells(Sayfa.Rows.Count, "B").End(xlUp).Row
    Sayfa.Range("A2:Ak" & Say).Copy
  
    With ThisWorkbook.Worksheets("SÖP")
        SonSatir = .Cells(Rows.Count, "B").End(xlUp).Row + 1
        .Cells(SonSatir, "B").PasteSpecial Paste:=xlValues
    End With
  
    Application.DisplayAlerts = False
    Sayfa.Parent.Close SaveChanges:=True
    Application.DisplayAlerts = True
    Label592.Enabled = False
End Sub

Çok çok teşekkürler Muzaffer Ali bey. Elinize sağlık.