VBA kodlarını son dolu satıra kadar uygulasın

[cemshan]

Merhaba arkadaşlar. Aşağıda yazdığım kodu kullanıyorum ancak sayfa ilerledikçe sürekli aralık miktarını güncellemek zorunda kalıyorum. Bu kodu son dolu satıra kadar uygulması için nasıl günceleyebilirim.

Sub gunluk()

Dim x1 As Worksheet
Dim x2 As Worksheet

Set x1 = Sheets("Girişlerr")
Set x2 = Sheets("Veri")

x1.Range("a2:a9000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c9000"), x2.Range("a:j"), 4, 0), "")
x1.Range("l2:l9000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c9000"), x2.Range("a:j"), 10, 0), "")
x1.Range("j2:j9000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c9000"), x2.Range("a:j"), 3, 0), "")
x1.Range("m2:m9000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c9000"), x2.Range("a:j"), 5, 0), "")
x1.Range("k2:k9000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("b2:b9000"), x2.Range("m:n"), 2, 0), "")

Call crpgetir

End Sub



Sub crpgetir()
With Sheets("Girişlerr").Range("h2:h9000")
.Formula = "=if(Girişlerr!f2*Girişlerr!m2=0,"""",Girişlerr!f2*Girişlerr!m2)"
.Value = .Value
End With

With Sheets("Girişlerr").Range("I2:I9000")
.Formula = "=if(Girişlerr!g2*Girişlerr!m2=0,"""",Girişlerr!g2*Girişlerr!m2)"
.Value = .Value
End With
End Sub

 

[AtaAri]

Merhaba
sn cemsan
sat kodu A sütununda son dolu hücrenin bulunduğu satırı verir.
Alttaki kodu çoklayarak devam edebilirsiniz.

Dim x1 As Worksheet, sat1 As Long
Set x1 = Sheets("Girişlerr")
sat = x1.Cells(65536, "A").End(xlUp).Row
x1.Range("a2:a" & sat) = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c" & sat), x2.Range("a:j"), 4, 0), "")

 

[skaan]

Deneyin lutfen..


Sub gunluk()
Dim x1 As Worksheet
Dim x2 As Worksheet
Dim lastRow As Long

Set x1 = Sheets("Girişlerr")
Set x2 = Sheets("Veri")
lastRow = x1.Cells(x1.Rows.Count, "C").End(xlUp).Row ' Son dolu satırı bulma

x1.Range("A2:A" & lastRow) = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("C2:C" & lastRow), x2.Range("A:J"), 4, 0), "")
x1.Range("L2:L" & lastRow) = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("C2:C" & lastRow), x2.Range("A:J"), 10, 0), "")
x1.Range("J2:J" & lastRow) = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("C2:C" & lastRow), x2.Range("A:J"), 3, 0), "")
x1.Range("M2:M" & lastRow) = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("C2:C" & lastRow), x2.Range("A:J"), 5, 0), "")
x1.Range("K2:K" & lastRow) = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("B2:B" & lastRow), x2.Range("M:N"), 2, 0), "")

Call crpgetir(lastRow) ' Son dolu satırı argüman olarak gönderme
End Sub

Sub crpgetir(lastRow As Long)
With Sheets("Girişlerr").Range("H2:H" & lastRow)
.Formula = "=IF(Girişlerr!F2*Girişlerr!M2=0,"""",Girişlerr!F2*Girişlerr!M2)"
.Value = .Value
End With

With Sheets("Girişlerr").Range("I2:I" & lastRow)
.Formula = "=IF(Girişlerr!G2*Girişlerr!M2=0,"""",Girişlerr!G2*Girişlerr!M2)"
.Value = .Value
End With
End Sub

 

[cemshan]

teşekkür ederim