- Katılım
- 8 Eylül 2009
- Mesajlar
- 5
- Excel Vers. ve Dili
- 2003 türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C9]) Is Nothing Then Exit Sub
If Application.WorksheetFunction.CountBlank(Range("C4:C9")) <> 0 Then
MsgBox "Tüm Bilgiler Girilmemiş " & WorksheetFunction.CountBlank(Range("C4:C9"))
Exit Sub
End If
Dim sat As Long
sat = Sheets("Sayfa2").[A65536].End(3).Row + 1
Range("C4:C9").Copy
Sheets("Sayfa2").Range("A" & sat).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Application.EnableEvents = False
Range("C4:C9").ClearContents
Application.EnableEvents = True
End Sub