| 
    
     |  | ▼VBAビギナー さん: こんばんは。
 
 実際に入力規則のリストメンバとして設定するセル範囲を
 Sheet1のA列ではなく、B列にしたらどうでしょうか?
 このB列で空白を詰めます。
 
 '====================================
 Sub tes()
 Dim radd As String
 Dim idx As Long
 With Worksheets("sheet1")
 .Range("b:b").ClearContents
 For Each crng In .Range("a1:a1000")
 If crng.Value <> "" Then
 .Cells(idx + 1, 2).Value = crng.Value
 idx = idx + 1
 End If
 Next
 radd = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Address(, , , True)
 End With
 
 With Range("A1").Validation
 .Delete
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
 xlBetween, Formula1:="=INDIRECT(""" & radd & """)"
 .IgnoreBlank = False
 .InCellDropdown = True
 .InputTitle = ""
 .ErrorTitle = ""
 .InputMessage = ""
 .ErrorMessage = ""
 .IMEMode = xlIMEModeNoControl
 .ShowInput = False
 .ShowError = False
 End With
 End Sub
 
 |  |