Makro ile tek hücrenin birden fazla dosyaya aktarılması.

[ordulu82]

Arkadaşlar örnekte de belirtttim. benim istediğim kaynak dosyanın e2 hücresindeki değerin birden fazla dosyaya aynı anda aktarılması.

 

[dEdE]

Merhaba,
Dosyanız ilişiktedir.

Sub BaskaDosyaVeriGonder()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Yol = ThisWorkbook.Path & "\VERİ\"
    Set COfs = CreateObject("Scripting.FileSystemObject")
For Each Dosya In COfs.GetFolder(Yol).Files
    If Dosya.Name <> "ANA.xlsm" Then
        Set WBook = Workbooks.Open(Yol & Dosya.Name)
        Set Sayfa = WBook.Sheets("veri" & Mid(Dosya.Name, 5, 1) & "ay")
        Sayfa.[D1] = Workbooks("ANA.xlsm").Sheets("Sayfa1").[E2]
        WBook.Close 1
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "İşlem Tamam...", vbInformation, "dEdE " & Application.UserName & "'e Başarılar Diler..."
End Sub

 

[ordulu82]

Merhaba,
Dosyanız ilişiktedir.

Sub BaskaDosyaVeriGonder()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Yol = ThisWorkbook.Path & "\VERİ\"
    Set COfs = CreateObject("Scripting.FileSystemObject")
For Each Dosya In COfs.GetFolder(Yol).Files
    If Dosya.Name <> "ANA.xlsm" Then
        Set WBook = Workbooks.Open(Yol & Dosya.Name)
        Set Sayfa = WBook.Sheets("veri" & Mid(Dosya.Name, 5, 1) & "ay")
        Sayfa.[D1] = Workbooks("ANA.xlsm").Sheets("Sayfa1").[E2]
        WBook.Close 1
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "İşlem Tamam...", vbInformation, "dEdE " & Application.UserName & "'e Başarılar Diler..."
End Sub

Sayın dEdE çalışma mükemmel olmuş. Fakat ben bu kodu kendi dosyama uygulayamadım. çünkü bendeki anasayfadaki kod sayfasının adı e2 hücresi değiştikçe otomatik değişiyor.
Ben daha kolay olsun, gerisini tamamlarım diye düşündüm ama yapamadım.Rica etsem kodları ekteki örneğe uyarlayabilirmisniz.

 

[dEdE]

Sayın dEdE çalışma mükemmel olmuş. Fakat ben bu kodu kendi dosyama uygulayamadım. çünkü bendeki anasayfadaki kod sayfasının adı e2 hücresi değiştikçe otomatik değişiyor.
Ben daha kolay olsun, gerisini tamamlarım diye düşündüm ama yapamadım.Rica etsem kodları ekteki örneğe uyarlayabilirmisniz.

Merhaba,
Demek ki neymiş?
Örnek dosyamızı asıl dosyamızla bire bir uyumlu yapacakmışız.

 

[ordulu82]

Merhaba,
Demek ki neymiş?
Örnek dosyamızı asıl dosyamızla bire bir uyumlu yapacakmışız.

Sayın dEdE e2 hücresi değişince sayfa adı da değiştiğinden debug hatası veriyor.

 

[ordulu82]

Hocam verdiğiniz koddaki Sayfa.[D1] = Workbooks("bordro.xlsm").Sheets("Ocak").[E2] satırını
Sayfa.[D1] = Workbooks("bordro.xlsm").activeSheet.[E2] oalrak değiştirdim, sanırım çalıştı ama acaba başka bir yerleri bozdum mu