• DİKKAT

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

Makroları birleştirme;

Katılım
8 Mart 2009
Mesajlar
504
Excel Vers. ve Dili
2010
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim alan As Byte, sh As Worksheet
If Intersect(Target, Range("A2:B2,C2,D2")) Is Nothing Then Exit Sub
Cancel = True
If Target.Address = "$A$2" Then
alan = 3
Set sh = Sheets("RAPOR")
ElseIf Target.Address = "$B$2" Then
alan = 8
Set sh = Sheets("RAPOR1")
ElseIf Target.Address = "$D$2" Then
alan = 5
Set sh = Sheets("RAPOR3")
ElseIf Target.Address = "$C$2" Then
alan = 4
Set sh = Sheets("RAPOR2")
End If

If Target <> "" Then
sh.Columns("A:BV").ClearContents
Range("A7").AutoFilter Field:=alan, Criteria1:="=*" & Target & "*"
Range("A7").CurrentRegion.Copy sh.Range("A7")
Range("A7").AutoFilter
sh.Select
sh.Cells.EntireColumn.AutoFit
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End If
Set sh = Nothing
End Sub

Sub ÖZET_RAPOR()
Application.ScreenUpdating = False
Set SL = Sheets("Sayfa1")
Set SR = Sheets("ÖZET RAPOR")
Kriter1 = SL.[D2]
Kriter2 = SL.[H2]
Kriter3 = SL.[I2]
Kriter4 = SL.[J2]
Kriter5 = SL.[K2]
SR.Columns("A:E").Clear
SL.Select
[A1].Select
Selection.AutoFilter
If Kriter1 = "" Then
Selection.AutoFilter Field:=2
Else
Selection.AutoFilter Field:=2, Criteria1:=Kriter1
End If
If Kriter2 = "" Then
Selection.AutoFilter Field:=3
Else
Selection.AutoFilter Field:=3, Criteria1:=Kriter2
End If
If Kriter3 = "" And Kriter4 = "" Then
Selection.AutoFilter Field:=4
ElseIf Kriter3 <> "" And Kriter4 = "" Then
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(CDate(Kriter3))
ElseIf Kriter3 = "" And Kriter4 <> "" Then
Selection.AutoFilter Field:=4, Criteria1:="<=" & CLng(CDate(Kriter4))
ElseIf Kriter3 <> "" And Kriter4 <> "" Then
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(CDate(Kriter3)), Operator:=xlAnd, Criteria2:="<=" & CLng(CDate(Kriter4))
End If
If Kriter5 = "" Then
Selection.AutoFilter Field:=5
Else
Selection.AutoFilter Field:=5, Criteria1:=">=" & Kriter5
End If
SL.[A7].CurrentRegion.Copy
SR.Select
[A7].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:E").EntireColumn.AutoFit
[A1].Select
SL.Select
Selection.AutoFilter
SR.Select
Application.ScreenUpdating = True
SAY = WorksheetFunction.CountA(SR.[A7:A65536])
If SAY = 0 Then MsgBox "VERDİĞİNİZ KRİTERLERE UYGUN KAYIT BULUNAMAMIŞTIR.", vbExclamation, "DİKKAT !"
Exit Sub
MsgBox "VERDİĞİNİZ KRİTERLERE UYGUN " & Format(SAY, "#,##0") & " ADET KAYIT BULUNMUŞTUR.", vbInformation
End Sub








bu iki makroyu nasıl birleştirmem gerekli kod bölümüne girdiğimde düzeltmeye çalıştığımda değişik değişik hatalar alıyorum.
 
Bunun için kodları birleştirmenize gerek yok birinci kodun uygun bir bölümüne veya kodun çalışmasını istediğiniz yere aşağıdaki kodu ekleyin yeterli.

Application.Run("ÖZET_RAPOR")

Böylelikle birinci kodun içerisinde Özet Rapor makrosu çalıştırılmış olur.
 
(Invalid outside procedure) ekleyince böyle diyor,

nereye eklemem gerekli.
 
Geri
Üst