• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kopyala yapıştır makrosunda sorun

mersilen

Destek Ekibi
Destek Ekibi
Katılım
31 Aralık 2009
Mesajlar
1,105
Excel Vers. ve Dili
excel 2007 türkçe
Excel Vers. ve Dili Ofis 2003
Merhabalar,
Yaklaşık 54 sütun-60 bin satırlık veri içeren 8 excel sayfasınıdaki aynı tabloları bir sayfada alt alta birleştirmek istiyorum.
Makro kaydet ile aşağıdaki kodu yazdım ama kod düzgün çalışmıyor.
Nerede hata yapıyor olabilirim?
Yardımlarınız için şimdiden teşekkür ederim

Kod:
Sub yapıştır()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
sonsatir1 = Sheets("s1").Range("A:A").End(xlUp).Row
SonSatir2 = Sheets("s2").Range("A:A").End(xlUp).Row + 1
    Sheets("s1").Select
    Range("A12:BB" & sonsatir1).Select
    Selection.Copy
    
    Sheets("s2").Select
    Range("A" & SonSatir2).Select
    ActiveSheet.Paste
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub
 
Sayın mersilen

Sayfa adlarını düzeltip aşağıdaki kod ile deneme yapın

Kod:
Sub yapıstır()
Dim sh1, sh2 As Worksheet, ek As Long
Dim sonsatir As Long
Set sh1 = ActiveWorkbook.Sheets("Sayfa1")
Set sh2 = ActiveWorkbook.Sheets("Sayfa2")
sonsatir = sh1.Cells(65536, 1).End(xlUp).Row
sh1.Range("$A$1:$BB$" & sonsatir).Copy
ek = sh2.Cells(65536, "A").End(xlUp).Row + 1
sh2.Cells(ek, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
 
Cevap için teşekkürler ama olmadı.

Run Time Error "9" Subscript Out Of Range Hatası alıyorum.
Sayfa isimleri doğru.

sh2 de A65502 satırına kadar dolu,
sh1 de A36246 satırına kadar dolu,

yaklaşık 7-8 sayfada 200-250 bin veri var.
 
İlginize teşekkür ederim
Aşağıdaki kodla sanırım işimi halledeceğim
Office 2007 türkçe kullanıyorum
Sanırım olay selection .copy den kaynaklanıyor
Kod:
Sub yapıştır2()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
sonsatir1 = Sheets("s1").Range("A1000000").End(xlUp).Row
sonsatir2 = Sheets("s2").Range("A1000000").End(xlUp).Row + 1
 For a = sonsatir1 To 12 Step -1
   sonsatir2 = Sheets("s2").Range("A1000000").End(xlUp).Row + 1
   Sheets("s1").Range("A" & a & ":BB" & a).Copy
   ' Selection.Copy
    Sheets("s2").Cells(sonsatir2, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

    
 Next a
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Geri
Üst