DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub AKTAR()
Dim I As Integer
Dim SUT, S As Byte
Sheets("HATIRLATMA SAYFASI").[A3:C500].Clear
For I = 2 To Sheets.Count
For SUT = 3 To 9
If Sheets("HATIRLATMA SAYFASI").[E1] = Sheets(I).Cells(SUT, "C") Then
Range(Sheets(I).Cells(SUT, "B"), Sheets(I).Cells(SUT, "D")).Copy
S = S + 1
Sheets("HATIRLATMA SAYFASI").Range(Cells(2 + S, "A"), Cells(2 + S, "C")).PasteSpecial
Application.CutCopyMode = False
End If
Next
Next
MsgBox "İşlem tamam.", vbInformation
End Sub