Soru 2 Makroyu Birleştirme Hakkında

[RBozkurt]

Merhaba
Kulanmış olduğum 2 adet makro var. Bunları nasıl ardarda beraber çalıştırabilirim?

Uygulama şu şekilde.
2 adet buton var.
1. sıradaki makro ile bilgisayardan ilgili kayıtlara ait excel dosyalarını seçiyorum ve ilgili sayfaya birleştiriyor.
2. makro da bu birleştirilmiş sayfadaki veriyi liste haline getiriyor.

Yapmak istediğim
Butona tıklayınca önce 1. makro çalışsın dosyaları seçtirsin. Dosyaları seçip, aktarma işleminden sonra da 2. makro çalışsın ve listeyi oluştursun.
1 butonu iptal etmek istiyorum.



1. Makro

Sub B_Makro1()
    Dim AktifDosya As Workbook
    Dim Dosya As Workbook
    Dim DosyaAdi
      
    Set AktifDosya = ActiveWorkbook
  
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Birleştirilecek Dosyaları Seçin"
      
        If .Show Then
            For Each DosyaAdi In .SelectedItems
                Set Dosya = Workbooks.Open(DosyaAdi)
              
                Dosya.Worksheets(1).UsedRange.Copy AktifDosya.Worksheets(3).Range("A65536").End(xlUp)(7, 1)
              
                Dosya.Close False
                Set Dosya = Nothing
            Next
        End If
    End With
  
    Set AktifDosya = Nothing
End Sub

2. Makro

Option Explicit

Sub C_makro2()
    Dim sonSatirKaynak As Integer
    Dim sonSatirHedef As Integer
    Dim kaynak As Worksheet
    Set kaynak = ThisWorkbook.Worksheets("MernisRapor")
    sonSatirKaynak = kaynak.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Dim hedef As Worksheet
    Set hedef = ThisWorkbook.Worksheets("MernisListe")
    
    Dim i As Integer
    For i = 1 To sonSatirKaynak
        If InStr(kaynak.Cells(i, 1).Value, "TC Kimlik") Then
        If InStr(kaynak.Cells(i - 2, 1).Value, "MERNİS VARİS LİSTESİ") Then
            sonSatirHedef = hedef.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            hedef.Cells(sonSatirHedef, 7).Value = " "        ' Mernis Varis Listesi Boşluk bırakıldı.
        End If
            sonSatirHedef = hedef.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            hedef.Cells(sonSatirHedef, 2).Value = kaynak.Cells(i + 1, 2).Value & " " & kaynak.Cells(i + 1, 4).Value        'isim soyisim
            hedef.Cells(sonSatirHedef, 3).Value = kaynak.Cells(i + 1, 6).Value        'Baba adı
            hedef.Cells(sonSatirHedef, 4).Value = kaynak.Cells(i + 1, 8).Value        'Anne adı
            hedef.Cells(sonSatirHedef, 5).Value = kaynak.Cells(i + 2, 6).Value        'Doğum yeri
            hedef.Cells(sonSatirHedef, 6).Value = kaynak.Cells(i + 2, 4).Value        'Doğum yılı
            hedef.Cells(sonSatirHedef, 7).Value = kaynak.Cells(i, 2).Value           'TC No
            hedef.Cells(sonSatirHedef, 9).Value = Mid(kaynak.Cells(i - 1, 1).Value, 21, InStr(1, kaynak.Cells(i - 1, 1).Value, ")", vbBinaryCompare) - 21)
            hedef.Cells(sonSatirHedef, 8).Value = kaynak.Cells(i + 3, 2).Value 'Adres bir sonraki sütuna taşındı
            
        End If
    Next i
    
    Dim j As Integer
    j = 0
    For i = 5 To sonSatirHedef
    If hedef.Cells(i, 2) <> "" Then
        hedef.Cells(i, 1) = j + 1
        j = j + 1
    End If
    Next i
    
    hedef.Select
        
End Sub

 

[RBozkurt]

Kurcalarken makro kaydet ile aşağıdaki şekilde denedim. Alternatif varmıdır? Dosya adı değişince sanırım çalışmaz. Her defa düzenlemek gerekir.

Sub Makro1()
'
' Makro1 Makro
'

'
    Application.Run "'DOSYAADI.xlsm'!B_Makro1"
    Application.Run "'DOSYAADI.xlsm'!C_Makro2"
End Sub

 

[AdemCan]

Merhaba, 1. makro ve 2. makro aynı dosyada ise
1. makroda, Set AktifDosya = Nothing satırından sonra Call C_makro2 yazınca çalışır.

 

[RBozkurt]

Merhaba, 1. makro ve 2. makro aynı dosyada ise
1. makroda, Set AktifDosya = Nothing satırından sonra Call C_makro2 yazınca çalışır.

Evet 2 makro da aynı dosyada bulunuyordu.
Teşekkür ederim.