İki Makroyu Birleştirme ve Uyarı Makrosu Hakkında

[vivident]

Arkadaşlar "uyarı" ve "aktar" isimli iki adet makrom var. İkisi de modül kısmında. İki sorum olacak.

1) Uyarı makrosu "FORM" sayfasının AS12:AS25 hücreleri içinde "X" var ise çalışıyor. Fakat bu hücre aralığı içinde kaç tane X varsa, o sayıda arka arkaya uyarı veriyor. Bu uyarıyı tek yapamazmıyız. Kullandığım kodlar aşağıdaki gibidir

2) Eğer problem varsa uyarı makrosu zaten çalışıyor. Uyarı makrosunda çıkan "TAMAM" ibaresine tıklayınca (birleştir makrosu nedeniyle) akabinde hemen aktar makrosu çalışıyor. Hemen çalışmasın ki ben problemi çözeyim. Zaten problem olduğu için uyarı makrosu yazdım

Sub Birlestir()
Call Uyarı
Call Aktar
End Sub

Sub Uyarı()
 Application.ScreenUpdating = False
 With Sheets("FORM")
For a = 12 To 25
    If Cells(a, 45).Value = "X" Then
         MsgBox "Eksikler var" & vbLf & _
        "Dosyayı kontrol edin", vbOKOnly
    End If
  Next
  End With
  Application.ScreenUpdating = True
End Sub

Sub Aktar()
Dim SAYFA As Worksheet, SATIR As Long, X As Long
Application.ScreenUpdating = False
With Sheets("Arsiv")
For Each SAYFA In ThisWorkbook.Worksheets
If SAYFA.Name <> "Sayfa1" And SAYFA.Name Like "FORM" Then
For X = 12 To SAYFA.Range("B65536").End(3).Row
SATIR = Sheets("Arsiv").Cells(65536, 5).End(3).Row + 1
.Cells(SATIR, 6) = SAYFA.Cells(X, 2)
.Cells(SATIR, 7) = SAYFA.Cells(X, 5)
.Cells(SATIR, 11) = SAYFA.Cells(X, 14)
.Cells(SATIR, 3) = SAYFA.Cells(X, 16)
.Cells(SATIR, 8) = SAYFA.Cells(X, 20)
.Cells(SATIR, 9) = SAYFA.Cells(X, 22)
.Cells(SATIR, 12) = SAYFA.Cells(X, 28)
.Cells(SATIR, 10) = SAYFA.Cells(X, 42)
.Cells(SATIR, 5) = SAYFA.Cells(X, 43)
SATIR = SATIR + 1
Next
End If
Next
End With
Sheets("Arsiv").Select
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Orion1]

Birlestir makrosunu silin.uyarı makrosunda birleştirdim ben aktar makrosunu.

Sub Uyarı()
Dim msj As String
 Application.ScreenUpdating = False
 With Sheets("FORM")
For a = 12 To 25
    If Cells(a, 45).Value = "X" Then
        GoTo mesaj
         
    End If
  Next
  End With
  Application.ScreenUpdating = True
  [B][COLOR="Red"]Call Aktar[/COLOR][/B]
  Exit Sub
mesaj:
MsgBox "Eksikler var" & vbLf & _
        "Dosyayı kontrol edin", vbCritical
End Sub

 

[vivident]

Elinize sağlık, on numara olmuş