İki dosyaya birden kayıt yapmak

[aydgur]

Sub sayfalaraaktaryeni2008()
Sheets("satış").Select
For x = 2 To [A65536].End(3).Row
Set s2 = Sheets(Cells(x, 1).Text)
sira = s2.[A65536].End(3).Row + 1
For y = 1 To 14
s2.Cells(sira, y) = Cells(x, y + 1)

Next y
Next x
Sheets("SATIŞ").Select
Range("A2:I80").ClearContents
Range("M2:Q80").ClearContents
Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))


10 MsgBox "CARİLERE AKTARILDI"
End Sub
Hepinizin Özgürlük Bayramını Kutlarım.
Yukarıdaki kod ile AYD dosyasının SATIŞ sayfasındaki sayfa adlarına göre aktarma yapabiliyorum.Peki diğer bir STD adlı dosyamdaki sayfalara da kayıt yapabilmek için kodda negibi değişiklik gerekir.

 

[Korhan Ayhan]

Selamlar,

İki dosyaya kaydetme işlemini yedekleme amaçlımı istiyor sunuz? Eğer cevabınız evetse dosyanızın kopyasını alabilirsiniz. Eğer cevabınız hayırsa iki dosyanızın bir örneğini eklerseniz sonuca daha çabuk ulaşabiliriz.

 

[aydgur]

Dosyalar gerçekten çok büyük.AYD dosyamda SATIŞ sayfasındaki sayfa adlarına göre aktarma yapabiliyorum,fakat bazı sayfalar STD dosyasında .STD dosyasındaki sayfalara da aktarma yapabilmek için kod nasıl değiştirilebilir.?

 

[Korhan Ayhan]

Selamlar,

Dosyalarınızın küçültülmüş örneklerinizi ekleyebilirsiniz.

 

[aydgur]

dosyalar ektedir.

 

[aydgur]

Pardon!dosyalar ektedir.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Koddaki kırmızı renkli bölümü kendi dosya yolunuza göre değiştirmeyi unutmayınız.

Sub AKTAR()
    Dim ASIL_DOSYA As String
    Dim HEDEF_DOSYA As String
    Dim X As Integer, Y As Byte, Z As Byte
    Set S1 = Sheets("SATIŞ")
    Application.ScreenUpdating = False
    S1.Select
    ASIL_DOSYA = ThisWorkbook.Name
    Workbooks.Open ("[COLOR=red][B]C:\Documents and Settings\Admin\Desktop\Yeni Klasör\STD.xls[/B][/COLOR]"), UpdateLinks:=0
    HEDEF_DOSYA = ActiveWorkbook.Name
    Windows(ASIL_DOSYA).Activate
    For X = 2 To [A65536].End(3).Row
    If SAYFA(S1.Cells(X, 1).Text) Then
    Set S2 = Sheets(S1.Cells(X, 1).Text)
    SATIR = S2.[A65536].End(3).Row + 1
    For Y = 1 To 14
    S2.Cells(SATIR, Y) = S1.Cells(X, Y + 1)
    Next Y
    Else
    Windows(HEDEF_DOSYA).Activate
    If SAYFA(S1.Cells(X, 1).Text) Then
    Set S3 = Workbooks(HEDEF_DOSYA).Sheets(S1.Cells(X, 1).Text)
    SATIR = S3.[A65536].End(3).Row + 1
    For Z = 1 To 14
    S3.Cells(SATIR, Z) = S1.Cells(X, Z + 1)
    Next Z
    End If
    MsgBox S1.Cells(X, 1).Text & " İSİMLİ SAYFA BULUNAMIŞTIR !", vbCritical, "DİKKAT !"
    Windows(ASIL_DOSYA).Activate
    End If
    Next X
    Workbooks(HEDEF_DOSYA).Close False
    S1.Range("A2:I80,M2:Q80").ClearContents
    S1.Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Application.ScreenUpdating = True
    MsgBox "CARİLERE AKTARILDI.", vbInformation
End Sub
 
Function SAYFA(SAYFAADI As String) As Boolean
    On Error Resume Next
    SAYFA = CBool(Len(Worksheets(SAYFAADI).Name) > 0)
End Function

 

[aydgur]

Teşekkür ederim.Adresi şöyle yaptım (Dosya masaüstünde adı: DENEME
("C:\Documents and Settings\aydpls\Desktop\deneme\STD.xls")
Fakat örneğin BINNUR sayfası bulunamadı diyor.STD dosyası kapalıydı.

 

[Korhan Ayhan]

Selamlar,

Size önerdiğim kodu denemiştim. Sayfa isimleri ile hücrede yazan isimler aynı olmalı yoksa hata mesajı alırsınız. Kontrol edermisiniz.

 

[aydgur]

Korhan bey; şu satı hatalı diyor.Benim dosyalarım Masaüstünde DENEME adlı klasör .ne yapabilirim?
---Workbooks.Open ("C:\Documents and Settings\Admin\Desktop\Yeni Klasör\STD.xls"), UpdateLinks:=0---

 

[Korhan Ayhan]

Selamlar,

Verdiğiniz dosya yolunu kendi sisteminize göre değiştireceksiniz. Yapacağınız işlem sadece bu.

Masa üstünde bulununan STD isimli dosyanızı açın.
Excel menü barının üzerinde sağ klik yapın ve açılan menüden WEB seçeneğini seçin. Dosyanızın yolunu kolaylıkla bu menüden görebilirsiniz. Bundan sonra orada yazan yolu kopyalayıp benim verdiğim koddaki bölüme uygulayacaksınız.

 

[aydgur]

Sn.Ayhan yolu yazdım ama yinede BINNUR isimli sayfa bulunamamıştır diyor.Merak ettiğim eğer ,STD adlı excel dosyam açıkken bu kod nasıl çalıştırılabilir.Çünkü STD ve AYD dosyası aynı anda açık olabiliyor.