- Katılım
- 21 Şubat 2007
- Mesajlar
- 384
- Excel Vers. ve Dili
- Microsoft Ev ve Ofis 2016
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub KAYDET()
'
' KAYDET Makro
'
'
Dim adet As Long
adet = WorksheetFunction.CountIf(Sheets("LİSTE").Range("C2:C65536"), "<>")
Range("B1:B8").Select
Selection.Copy
Sheets("LİSTE").Select
Application.Goto Reference:="R99999C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(-1, -1).Range("A1").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=ActiveCell.Range("A1:A2"), Type:= _
xlFillDefault
ActiveCell.Range("A1:A2").Select
Sheets("giriş").Select
ActiveCell.Offset(1, 0).Range("A1:A5").Select
Selection.ClearContents
ActiveCell.Offset(-1, 0).Range("A1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range("B2").Select
Range("B1") = adet + 1
End Sub
Kodları aşağıdaki şekilde değiştirip deneyin.
Kod:Sub KAYDET() ' ' KAYDET Makro ' ' Dim adet As Long adet = WorksheetFunction.CountIf(Sheets("LİSTE").Range("C2:C65536"), "<>") Range("B1:B8").Select Selection.Copy Sheets("LİSTE").Select Application.Goto Reference:="R99999C1" Selection.End(xlUp).Select ActiveCell.Offset(1, 1).Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True ActiveCell.Offset(-1, -1).Range("A1").Select Application.CutCopyMode = False Selection.AutoFill Destination:=ActiveCell.Range("A1:A2"), Type:= _ xlFillDefault ActiveCell.Range("A1:A2").Select Sheets("giriş").Select ActiveCell.Offset(1, 0).Range("A1:A5").Select Selection.ClearContents ActiveCell.Offset(-1, 0).Range("A1").Select ActiveCell.Offset(1, 0).Range("A1").Select Range("B2").Select Range("B1") = adet + 1 End Sub
Sub KAYDET()
'
' KAYDET Makro
'
'
'BURADA ADET İÇİN TANIMLAMA YAPILDI.
Dim adet As Long
Range("B1:B8").Select
Selection.Copy
Sheets("LİSTE").Select
Application.Goto Reference:="R99999C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(-1, -1).Range("A1").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=ActiveCell.Range("A1:A2"), Type:= _
xlFillDefault
ActiveCell.Range("A1:A2").Select
Sheets("giriş").Select
ActiveCell.Offset(1, 0).Range("A1:A5").Select
Selection.ClearContents
ActiveCell.Offset(-1, 0).Range("A1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range("B2").Select
'AŞAĞIDAKİ 2 SATIR EKLENDİ.
'LİSTE SAYFASINDAKİ C2 DEN SONRAKİ DOLU HÜCRE SAYISI BULUNDU.
adet = WorksheetFunction.CountIf(Sheets("LİSTE").Range("C2:C65536"), "<>")
'BULUNAN ADET SAYISI 1 ARTIRILARAK Giriş SAYFASI B1 HÜCRESİNE YAZIDIRILDI.
Sheets("giriş").Range("B1") = adet + 1
End Sub