• DİKKAT

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

Makro taşımak

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,506
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Arkadaşlar, sayın hocalarım, sorunun benzerini daha önce sormuştum ama daha basit olacak. Yapay zekaya yazdırdım. Ama sürekli hata veriyor.
Masaüstünde sablon.xlsm dosyasının "Makro" adlı sayfası kod bölümünden kodu alacak, yine masaüstü test.xlsx adlı dosyanın "Sayfa1" adlı sayfası kod bölümüne yapıştıracak ve masaüstüne test2.xlsm olarak kaydedecek. Böyle anlattım. Hata nerede acaba.
Şimdiden teşekkür ederim.
Saygılarımla.


Kod:
Sub SayfaKoduKopyalaYapistir()

    Dim wbKaynak As Workbook
    Dim wbHedef As Workbook
    Dim kaynakKod As String
    
    Dim masaustu As String
    masaustu = Environ("USERPROFILE") & "\Desktop\"
    
    ' Dosyaları aç
    Set wbKaynak = Workbooks.Open(masaustu & "sablon.xlsm")
    Set wbHedef = Workbooks.Open(masaustu & "test.xlsx")
    
    ' Kaynak sayfanın CodeName'ini bul
    Dim kaynakCodeName As String
    kaynakCodeName = wbKaynak.Worksheets("Makro").CodeName
    
    ' Hedef sayfanın CodeName'ini bul
    Dim hedefCodeName As String
    hedefCodeName = wbHedef.Worksheets("Sayfa1").CodeName
    
    ' Kaynak kodu al
    With wbKaynak.VBProject.VBComponents(kaynakCodeName).CodeModule
        kaynakKod = .Lines(1, .CountOfLines)
    End With
    
    ' Hedef kodu temizle ve yapıştır
    With wbHedef.VBProject.VBComponents(hedefCodeName).CodeModule
        .DeleteLines 1, .CountOfLines
        .AddFromString kaynakKod
    End With
    
    ' XLSM olarak kaydet
    wbHedef.SaveAs Filename:=masaustu & "test2.xlsm", _
                   FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    wbKaynak.Close False
    wbHedef.Close True

    MsgBox "Tamamlandı"

End Sub
 
Geri
Üst