重複使用VBA

lamwc

各位好，想請教一下如何使用VBA在各表的底下新增一列並下拉上列的公式，同時在公式當中設定代數以便後續再次新增使用，謝謝。

目前構想如下，剛接觸沒多久，希望有大神指教指教。



----------------------------------------------------------
Sub 巨集1()
'
' 巨集1 巨集
'

'
Dim x As Integer
Dim y As Integer
x = 18
y = 1


    ActiveWindow.SmallScroll Down:=18
    Range("x:x,x+19+1*y:x+19+1*y,x+38+2*y:x+38+2*y,x+57+3*y:x+57+3*y").Select
    Range("A75").Activate
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   
    Range("A(x-1):E(x-1)").Select
    Range("E(x-1)").Activate
    Selection.AutoFill Destination:=Range("Ax-1:Ex"), Type:=xlFillDefault
    Range("Ax-1:Ex").Select

    Range("A(x+19+1*y-1):F(x+19+1*y-1)").Select
    Range("F(x+19+1*y-1)").Activate
    Selection.AutoFill Destination:=Range("A(x+19+1*y-1):F(x+19+1*y)"), Type:=xlFillDefault
    Range("A(x+19+1*y-1):F(x+19+1*y)").Select
   
    Range("A(x+38+2*y-1):G(x+38+2*y-1)").Select
    Range("G(x+38+2*y-1)").Activate
    Selection.AutoFill Destination:=Range("A(x+38+2*y-1):F((x+38+2*y)"), Type:=xlFillDefault
    Range("A(x+38+2*y-1):F(x+38+2*y)").Select
   
    Range("A(x+57+3*y-1):H(x+57+3*y-1)").Select
    Range("H(x+57+3*y-1)").Activate
    Selection.AutoFill Destination:=Range("A(x+57+3*y-1):H(x+57+3*y)"), Type:=xlFillDefault
    Range("A(x+57+3*y-1):(x+57+3*y)").Select


End Sub

lamwc

第一行列 我應該已調整成合理的格式 但依然跑不動   

Range(x & ":" & x, x + 19 + 1 * y & ":" & x + 19 + 1 * y, x + 38 + 2 * y & ":" & x + 38 + 2 * y, x + 57 + 3 * y & ":" & x + 57 + 3 * y).Select

samwang

回復 2# lamwc


可否附上檔案且加以說明，謝謝

ikboy

沒有附件, 衹能猜想

1. Selection.resize(2).Filldown

複製代碼

ML089

回復 2# lamwc

Rs = x & ":" & x & "," & x + 19 + 1 * y & ":" & x + 19 + 1 * y & "," & x + 38 + 2 * y & ":" & x + 38 + 2 * y & "," & x + 57 + 3 * y & ":" & x + 57 + 3 * y
debug.print  Rs  '  "18:18,38:38,58:58,78:78"
Range(Rs).Select

每行先印出來檢查是否有問題