mustafa1205
Altın Üye
- Katılım
- 23 Ekim 2010
- Mesajlar
- 1,436
- Excel Vers. ve Dili
- Office 2016 / 64 Bit - Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Syn. Mustafa1207;Ekte örnekte bulunan çalışmam da yapmak istediğim en son dolu satırı bir alt satıra kopyalamak istiyorum.Teşekkürler
Private Sub CommandButton1_Click()
sat = Range("B2:B63563").End(4).Row
For i = 2 To 5
Cells(sat + 1, i) = Cells(sat, i)
Next i
End Sub
Sub Kopyala()
Dim son As Long
son = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & son, "E" & son).Copy Range("B" & son + 1)
End Sub
Hocam bu soruyu şu şekilde güncellemek istiyorum. Acaba düğmeye bastığımızda kaç adet son satırı kopyalamak istediğimizi soran ve içine rakamı girdiğimizde o kadar altalta kopyalama yapmasını sağlayabilirmiyiz acaba?
Sub Kopyala()
Dim son As Long, adet As String
adet = Application.InputBox("Kopya Sayısı", "Satır Kopyalama")
If adet = False Then Exit Sub
son = Cells(Rows.Count, "B").End(xlUp).Row
On Error GoTo atla
Range("B" & son, "E" & son).Copy Range("B" & son + 1, "B" & son + adet)
Exit Sub
atla:
MsgBox "Girilen Değeri Kontrol Edin"
End Sub
Yani sizin ilk anlatımınızdaki gibi olacak hocam
Sub Kopyala()
Dim son As Long, plan As Variant, c As Range, sonk As Long
plan = Application.InputBox("Plan Secin", "Satir Kopyalama")
If plan = False Then Exit Sub
Set c = Range("G2:J2").Find(plan, LookIn:=xlValues)
If Not c Is Nothing Then
sonk = Cells(Rows.Count, c.Column).End(xlUp).Row
Else
MsgBox "Girilen Değeri Kontrol Edin": Exit Sub
End If
son = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & son, "E" & son).Copy Range("B" & son + 1, "B" & son + sonk - 2)
Range(Cells(3, c.Column), Cells(sonk + 2, c.Column)).Copy Range("F" & son + 1)
End Sub