• DİKKAT

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

Makroları kopyalamak

C

cengiz123

Katılım
25 Mart 2017
Mesajlar
177
Excel Vers. ve Dili
2013
Merhabalar
Bir konuda yardımınıza ihtiyacım var.
Bir çalışma kitabına dışardan duruma göre excel sayfaları yüklüyorum.yaklaşık 50 excel sayfası var.

Ben dışardan yüklediğim sayfalara Private Sub() yani thisworkbook kısmında kodlar yazdım. Hücreye çift tıklayınca işlem yapan makrolardan.

Bu işlem için, dışardan yüklediğim sayfalara önceden bu kodları tek tek yazmam gerekiyor.
Sorum ise;

Bu makro kodların kopyalanma özelliği var mıdır?
Yani yeni yüklenen sayfaya thisworkbook kısmına bu kodları kopyalayıp yapıştırabilir miyim?
 
Son düzenleme:
bu çözümü hatırlamaya çalışıyorum ama yanlış yönlendirmek istemem. faydam olsun diye yukarı taşıyalım konuyu bilen birisi yazarsa ben de notlarım arasına eklerim.
 
Öneri1: Eğer verilerinizin düzeni aynı şekilde ise sayfa kopyalamak yerine cells ile verileri daha önceden hazırladığınız şablon sayfayı kopyalayarak bu sayfaya kopyalayın. Makrolar bu sayfada olduğu için kodlar da gelecektir.
Öneri2: Sayfa kopyalamak zorunlu ise kodlarınızı modüle yazın. Modül kopyalama olarak aratırsanız çözüm bulabilirsiniz.
 
Merhabalar
Cells ile denedim. Hücre içindeki resimleri kaydırıyor.
İkincisi, modüle kopyalamak maalesef olmuyor yada ben bilmiyorum.
Çünkü yüklenen sayfalarda hem buton olması gerekir, hemde bir hücreye çift tıklayınca makro çalıştıran komut.
Belki ben yanlış biliyorumdur
 
Dosyaları ben indiremiyorum.
Sadece bir sayfada kod var.oda işimi görmedi
 
O kod farklı 1 nolu mesajdaki dosyaları indirip irdeleyiniz.

Altın üyeler indirebiliyor.
 
merhabalar,
dosyayı indirdim ancak, tam anlamıyla sorduğum sorunun cevabını bulamadım. dosya içindeki hangi kod, kodları kopyala yapıştır yapıyor?
 
merhabalar,
dosyayı indirdim ancak, tam anlamıyla sorduğum sorunun cevabını bulamadım. dosya içindeki hangi kod, kodları kopyala yapıştır yapıyor?
Genişletmek için tıkla ...


cengiz123' Alıntı:
Merhabalar
Bir konuda yardımınıza ihtiyacım var.
Bir çalışma kitabına dışardan duruma göre excel sayfaları yüklüyorum.yaklaşık 50 excel sayfası var.

Ben dışardan yüklediğim sayfalara Private Sub() yani thisworkbook kısmında kodlar yazdım. Hücreye çift tıklayınca işlem yapan makrolardan.

Bu işlem için, dışardan yüklediğim sayfalara önceden bu kodları tek tek yazmam gerekiyor.
Sorum ise;

Bu makro kodların kopyalanma özelliği var mıdır?
Yani yeni yüklenen sayfaya thisworkbook kısmına bu kodları kopyalayıp yapıştırabilir miyim?
Genişletmek için tıkla ...

1 nolu mesajındaki kırmızı bölümdeki yazınız doğrultusunda siz ThisWorkbook kod bölümüne hangi makroyu kopyalayıp yapıştıracaksınız.
Mokroyu buraya yazın.
 
Merhaba Halit hocam

Sayfa1'in kod görüntüle bölümüne, butona tıklayınca aşağıdaki kodlar yazdırılabilir mi ?

Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [A7:Z7]) Is Nothing Then Exit Sub If Target.Value = 123 Then Call makro8 End Sub
 
Merhaba Halit bey
İlginiz ve desteğiniz için teşekkürler.
Dosyanın çalışmasını anladım.
Siz bunu userform ile yapmışsınız.
Peki bunu excel dosyası açılırken(auto_open) bu kodu çalıştırabilir miyiz? Bu userformdaki işlemin alt kodlarını auto_open'a monte edebilir miyiz?
Kusura bakmayın çok soru sordum
 
Böyle olurmu

Sizin yazacağınız kodu sayfaya yazmak lazım oysa auto_open olayı olunca kod tetiklenir siz ne zaman sayfaya bu kodları yazacaksınız.

auto_open olayında dosya açılır açılmaz aktarılır kontrol sizden çıkar oysa bu userform olayı çok fonksiyonlu ve kullanışlı
 
Ben dışardan bir excel sayfası yüklüyorum. Yüklenen sayfa "sayfa2" adında olsun.Burada bu kodu otamatik kullanmak istiyorum. Yükleme işlemini butonla yapıyorum. Peki bu 'import' butonuna bu kodu eklesek ve bu kodu kitabın içine yüklenen "sayfa2"ye yazdırabilir miyiz?
 
Son düzenleme:
Bu iş uzayacak herhalde sizin ne istediğinizi anlamış değilim.
Burada yapılan açık dosyada A sutunundaki makro kodlarının hepsini dosyaların bulunduğu klasörü kod seçiyor sonra klasörün içindeki dosyayı açıyor eğer kod sayfası Sayfa1 ise kodları oraya yapıştırıyor.

Kod: 
Sub mokro_ekle()

Uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare) - 1)

Set Klasor = CreateObject("shell.application").browseforfolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)

If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.path 'Klasor.Items.Item.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Liste (Kaynak)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "işlem tamam"

Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
    
Set Obj = Nothing
Set Klasor = Nothing

End Sub

Private Sub Liste(Yol As String)
On Error Resume Next

Sayfa = "[COLOR="Red"]Sayfa1[/COLOR]"
yaz = ""
For i = 1 To ThisWorkbook.Sheets(ActiveSheet.Name).Cells(Columns.Count, "A").End(3).Row
yaz = yaz & Chr(10) & ThisWorkbook.Sheets(ActiveSheet.Name).Cells(i, 1).Value
Next

Dim fL As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject").getfolder(Yol).SubFolders

For Each Dosya In CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files
If UCase(Right(Dosya.Name, Len(Uzanti))) = UCase(Uzanti) Or UCase(Right(Dosya.Name, Len(Uzanti))) = UCase("csv") Then
If ThisWorkbook.Name <> Dosya.Name Then

Dim wb As Workbook

Set wb = Workbooks.Open((Dosya), Password:="", WriteResPassword:="")

Workbooks(Dir(Dosya)).Activate


For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
If Sayfa = VBComp Then
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(Sayfa).CodeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
End If
Next

For Each user In ThisWorkbook.VBProject.VBComponents
If Sayfa = user.Name Then
deg6 = ActiveWorkbook.VBProject.VBComponents(Sayfa).CodeModule
ActiveWorkbook.VBProject.VBComponents(deg6).CodeModule.InsertLines 1, yaz
End If
Next



ActiveWorkbook.Save
ActiveWorkbook.Close
'Dosya = Dir
End If
End If
Next


On Error GoTo sonraki
For Each f In fL
Liste (f.path)
sonraki:
Next
Set fL = Nothing

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst