迴圈寫法問題

發現以下程式碼有錯。
要如何才能讓D1的值去重複讀取A欄的值往下 ?
例如: A1到A1000
------------------
Sub 迴圈()
'
' 迴圈  Macro       
                                  
     For Each k In Sheets("sheelt1").Range("a:a")          '迴圈要連續處理處理sheelt1 A欄的儲存格
    
           Range("D1").Select =k .Value             
                
                              Application.Run Macro:= "A"  '使用原本sheelt1裡的模組A
               Next
End Sub
-------------------
可 更改為如下程式碼：-
Sub yy()
For Each c In [a:a].SpecialCells(2)
[d1] = c
Next
End Sub
-----------------
問：
還有一個問題 A模組還是無法執行，請問如何執行A模組？
-----------------
答：
Application.Run Macro:= "sheelt1.A"   使用原本sheelt1裡的巨集名稱A
Application.Run Macro:= "A"    一般模組的巨集名稱A
-----------------
現在又有一個問題了，程式碼如下：
Sub yy()
   For Each c In [A:A].SpecialCells(2) 
          [D1] = c
                 Application.c Now + TimeValue("00:00:30")
     Next
                 Application.Run Macro:= "A"
End Sub

D1儲存格因連接到其它的工作表單為動態更新外部資料IQY
從A1讀取儲存格時因會出現一個重複迴圈而沒有停駐使查詢沒有傳回資料
請問如何從A1到D1時停駐一段時間後再去執行A2,A3,A4.............到A?儲存格
可用時間設定讓他去延長等待時間嗎?
----------------
答：
例如延10秒：Application.OnTime Now + TimeSerial(0, 0, 10),"Dosomething"
---------------
我試過
Application.OnTime Now + TimeSerial(0, 0, 10), "Dosomething"   '延長等待時間10秒
會顯示無法執行巨集 Excel 會無法關閉 必需強制關閉
而單獨寫成一個巨集可以執行

試過在 迴圈裡讀取此巨集 但D1裡資料會停在A1儲存格  不用強制關閉excel
Application.Run Macro:= "A" 也沒有動作
也不會繼續往下讀取A欄裡的A2,A3,A4.............到A?儲存格
=================================================================
巨集裡的

1. Sub Time()
   
2.   Application.OnTime Now + TimeSerial(0, 0, 10), " yy"
   
3. End Sub

複製代碼

=================================================================
迴圈裡的

1. Sub yy()
   
2.    For Each c In [A:A].SpecialCells(2) 
   
3.           [D1] = c
   
4.           If c = "" Then Exit For
   
5.                 Application.Run Macro:= "Time"
   
6.      Next
   
7.                 Application.Run Macro:= "A"
   
8. End Sub

如何解決？
----------------------------------
試一下以下更改了的程式碼：
Sub yy()
    For Each c In [A:A].SpecialCells(2)
    [D1] = c
    Application.Run Macro:="A"
    t = Timer
    Do
    DoEvents
    Loop Until Timer - t = 2
    Next
End Sub
Sub A()
For i = 1 To 1000
[e1] = i
Next
End Sub
------------------------