macrolu veriyi başka excel dosyasına nasıl aktarırız?

[subutayı]

arkadaşlar veri dosyasının sayfa2 içindeki çalıştıra tıkladığımızda işlemi sayfa1 aktarıyor. kodda düzenleme yapılarak söküm_sırası dosyasının sayfa1 aktarılması gerekiyor. yol olarak C\SÖKÜM klasörü olsun. her iki dosyamda C dayrektörünün altındaki SÖKÜM klasörünün içinde bulunuyor. teşekürler.

 

[kemalist]

bakarmısınız

 

[subutayı]

sayın kemalist,
denedim ama söküm_sırası nın içine göndermiyor. yine verideki sayfa1 içine gönderiyor. veri dosyasının sayfa1 ne göndermesin. söküm_sırası dosyasının sayfa1 ne göndersin. kontrol edebilirmisiniz.

 

[kemalist]

her ikisinede gönderiyor

 

[subutayı]

debug hatası veriyor. debug a tıklayınca gittiği satır
Windows("söküm_sırası.xls").Activate
veri deki sayfa1 silecem oraya göndermesine gerek yok. söküm_sırası nın sayfa1 ne göndermesi yeterli. söküm klasörünü C dayrektörünün altına attım denedim. söküm_sırası na atmıyor. teşekürler

 

[kemalist]

Sub deneme()
Dim a(), b(), c(), d As Object, Krt As Variant
Dim S1 As Worksheet, S2 As Worksheet
Dim i As Long, Say As Long, Son As Long, X As Long, Y As Long
Dim Ay As Integer, Yil As Integer, t As Double, toplam As Double
Application.ScreenUpdating = False
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")

Ay = S2.[H2]
Yil = S2.[I2]
t = Timer
Set d = CreateObject("Scripting.Dictionary")
Son = S2.Range("A" & Rows.Count).End(3).Row
a = S2.Range("A2:C" & Son)
ReDim b(1 To UBound(a), 1 To 34)

For i = 1 To UBound(a)
Krt = a(i, 1) & "|" & a(i, 2)
If Month(a(i, 3)) = Ay And Year(a(i, 3)) = Yil Then
If Not d.exists(Krt) Then
Say = Say + 1
d.Add Krt, Say
b(Say, 1) = Yil
b(Say, 2) = a(i, 1)
b(Say, 3) = a(i, 2)
End If

For X = 1 To 31
If Day(a(i, 3)) = X Then
b(d.Item(Krt), X + 3) = b(d.Item(Krt), X + 3) + 1
Else
b(d.Item(Krt), X + 3) = b(d.Item(Krt), X + 3) + 0
End If
Next X
End If
Next i
S1.Range("A3:AH" & Rows.Count).ClearContents
If Say > 0 Then
S1.Range("A3").Resize(Say, 34) = b
End If
For Y = 4 To 34
toplam = toplam + Application.Sum(Application.Index(b, , Y))
Next Y
Application.ScreenUpdating = True
MsgBox "Toplam Gün : " & toplam & vbLf & vbLf & "İşlem Süreniz : " & Format(Timer - t, "0.00") _
& vbLf & vbLf & "İşleminiz Tamamlandı.", vbInformation

Windows("veri.xls").Activate
Sheets("Sayfa1").Select
Range("A3:C5459").Select
Selection.Copy

Windows("söküm_sırası.xls").Activate
Sheets("Sayfa1").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("veri.xls").Activate
Sheets("Sayfa1").Select
Range("A3:C5459").Select
Selection.ClearContents
End Sub

kodu komple kopyalayıp yapıştırın

 

[subutayı]

üzgünüm üstadım,
deniyorum ama olmuyor. söküm_sırası na hiç bir şey gelmiyor.

 

[kemalist]

bende çalışıyor hata yok veri sayfa1 den söküm sırası sayfa 1 e gidiyor

dosya ektedir

 

[subutayı]

veri sayfası2 deki çalıştıra tıklıyorsunuz. söküm_sırası sayfa1 gönderiyor diyorsunuz. doğru mu anlıyorum. ben bu şekilde yapıyorum. ama söküm_sırası sayfa1 e hiç bir şey gelmiyor.

 

[subutayı]

sayın kemalist,
Range("A3:C5459").Select olan satırı Range("A3:AH5459").Select olarak değiştirince tümünü Söküm_sırası nın sayfa1 ne gönderdi. eyvallah üstadım, teşekkür ederim. sağol

 

[subutayı]

sayın kemalist,
Windows("söküm_sırası.xls").Activate
yukardaki satırda debug hatası veriyor. söküm_sırası dosyasına göndermiyor bilginize

 

[kemalist]

yukarıdaki makroda A3:C5459 olarak verildiğinden bu şekilde düzenleme yapıldı,,,

 

[subutayı]

sayın Kemalist,
veri sayfası2 de çalıştır a tıkladığımda kod debug hatası veriyor. söküm_sırasına yapıştırma yapmıyor.
hata satırı
Windows("söküm_sırası.xls").Activate