excel vba formülü döngüye sokmak

Kodla Büyü

s_kajmeran

Hiperaktif Üye
Hiperaktif
Mesajlar
3,888
Range("j141").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=tasıma!$j$1:$j$75"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


yukardaki formül tasıma sayfasındaki j1:j75 aralığındaki bilgileri; ilgili sayfada sayfa1 j141 hücresine veri doğrulama liste şeklinde alıyor... Ben bunu bir döngü aracılığı ile
tasıma sayfası k1:k75 aralığını sayfa1 k141'e
tasıma sayfası l1:l75 aralığını sayfa1 l141'e
....
...

gibi atamak istiyorum... Nasıl bir döngüye sokmalıyım ilgili formülü...
 
Sub CreateDropdowns()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim col As Integer, lastRow As Long

' Çalışma sayfalarını tanımla
Set ws1 = ThisWorkbook.Sheets("Sayfa1")
Set ws2 = ThisWorkbook.Sheets("Sayfa2")

' Sütun döngüsü (A'dan F'ye, 1'den 6'ya)
For col = 1 To 6
' Sayfa1'deki ilgili sütundaki son dolu satırı bul
lastRow = ws1.Cells(ws1.Rows.Count, col).End(xlUp).Row

' Açılır listeyi oluştur
With ws2.Cells(1, col).Validation
.Delete ' Önce eski doğrulamayı temizle
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='" & ws1.Name & "'!" & ws1.Range(ws1.Cells(1, col), ws1.Cells(lastRow, col)).Address
.IgnoreBlank = True
.InCellDropdown = True
End With
Next col

MsgBox "Açılır listeler oluşturuldu!", vbInformation
End Sub
 
BBNET
Geri
Üst