Kod:
Range("A3").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Range("A3").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
(08/05/2021, 17:07)Oğuz Türkyılmaz yazdı: BU sorunu çözdüm @feraz hocam. Aşağıdaki kodla da sonboş satıra gidebiliyorum. Benim sorunum bunu döngüde nasıl kullanacağımı bilememek.Bu kodu kullanmak sakıncalı çünkü eğer satırlar arasında boş satır varsa en alta gitmez.
Kod:Range("A3").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
#If VBA7 Then 'Numlock icin
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#Else
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#End If
Sub Test()
Dim i As Long, son As Long
With ThisWorkbook.Sheets("MESAJ")
son = .Cells(Rows.Count, 1).End(3).Row
If son < 2 Then
MsgBox "Gönderilecek mesaj yok", vbCritical, "hata"
Exit Sub
End If
For i = 2 To son
DoEvents
.Shapes("Ymza").Copy
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "https://web.whatsapp.com/send?phone=" & .Cells(i, 1).Value & "&text=" & .Cells(i, 2).Value
Application.Wait Now + TimeValue("00:00:05")
SendKeys "^v" 'v normal v
Application.Wait Now + TimeValue("00:00:05")
Call SendKeys("{Enter}", True)
Application.Wait Now + TimeValue("00:00:05")
SendKeys "^{F4}"
Application.Wait Now + TimeValue("00:00:05")
Call SendKeys("{Enter}", True)
Set ie = Nothing
Next
End With
Application.CutCopyMode = False
If GetKeyState(vbKeyNumlock) = 0 Then SendKeys "{NUMLOCK}", True 'Numlock icin
MsgBox "Bitti"
End Sub
Cells(ActiveSheet.Row.Count, 1). End(xlUp).Offset(1, 0 ).Select
(08/05/2021, 17:50)feraz yazdı:(08/05/2021, 17:45)Oğuz Türkyılmaz yazdı:Bu kod son satırın bir altını seçer yani satır numarasını vermez.Kod:Cells(ActiveSheet.Row.Count, 1). End(xlUp).Offset(1, 0 ).Select
Doğrusu bu olacak
Hocam Tam da iz üstündeydim. Benden çabuk davrandınız