複製到空白的最上格

myleoyes

各位前輩你們好!
             前輩!!範圍為[E3:E30]
            現在[E3,E4,E5,E8,E10,E22]<>""
            小第用此程式
            [A1].Copy: [E30].End(xlUp)(2.1).PasteSpecial xlPasteValues
            只能將[A1]複製到E23的位置
            但需求的位置是 E6
            不知程式為何?
            請不吝再賜教謝謝再三!!

Hsieh

回復 1# myleoyes

If Application.CountA([E3:E30]) < 28 Then Range("E3:E30").SpecialCells(xlCellTypeBlanks).Cells(1) = [A1]

myleoyes

回復 2# Hsieh
前輩!!謝謝!!程式ok!
               但問題沒有ok!
               如附檔說明,晚安!!
               請不吝再賜教謝謝再三!!

Hsieh

回復 3# myleoyes

1. Sub YY()
   
2. Dim A As Range
   
3.     If Application.CountA([F3:F30]) < 28 Then
   
4.     Set A = Range("E3:E30").SpecialCells(xlCellTypeBlanks).Cells(1)
   
5.      A = Evaluate("=TEXT(CEILING((EDATE(A1,0)-8)/7,1)*7+7,0)+ 14"): A.Offset(, 1) = [C3]
   
6.     End If
   
7. End Sub

複製代碼

myleoyes

回復 4# Hsieh
偶像前輩!!謝謝!!再請教這個找最大()程式
         如附檔案說明!
         請不吝再賜教謝謝再三!!

myleoyes

回復 4# Hsieh
偶像前輩!不用再麻煩你,程式已找到
      只是還要再多一個輔助格,總覺得自己都沒有成長謝謝再三!!
      Sub 找最大()
          Set c = [E3:E30].Find([AB2], , , 1)
           If Not c Is Nothing Then c.Select: ActiveCell = "=TEXT(CEILING((EDATE(A1,0)-8)/7,1)*7+7,0)+ 14"
           :  ActiveCell = Selection: ActiveCell.Offset(0, 1).Select: ActiveCell = [C2]: [AA1] = "":     
     End Sub