使用VBA副本表宏和公式r1c1

时间:2016-09-16 20:04:52

标签: excel vba excel-vba

也许我已经盯着这个太久了,但我有一个宏可以在Excel中复制工作表。我还想尝试将其包含在循环中(只是来自此录制宏的R1C1公式):

Sub Macro4()
'
' Macro4 Macro
'
' Keyboard Shortcut: Ctrl+a
'
Sheets("<Null>").Select
ActiveSheet.Buttons.Add(541.5, 97.5, 95.25, 43.5).Select
ActiveSheet.Buttons.Add(541.5, 169.5, 94.5, 42.75).Select
Sheets("<Null>").Copy After:=Sheets(3)
ActiveCell.FormulaR1C1 = "='Dividing Walls Only'!RC[-2]"
Range("C4").Select
Sheets("<Null> (2)").Select
ActiveSheet.Buttons.Add(541.5, 97.5, 95.25, 43.5).Select
ActiveSheet.Buttons.Add(541.5, 169.5, 95.25, 42.75).Select
Sheets("<Null> (2)").Copy After:=Sheets(4)
Range("C3").Select
ActiveCell.FormulaR1C1 = "='Dividing Walls Only'!R[1]C[-2]"
Range("C4").Select
Sheets("<Null> (3)").Select
ActiveSheet.Buttons.Add(541.5, 97.5, 95.25, 43.5).Select
ActiveSheet.Buttons.Add(541.5, 169.5, 95.25, 42.75).Select
Sheets("<Null> (3)").Copy After:=Sheets(5)
Range("C3").Select
ActiveCell.FormulaR1C1 = "='Dividing Walls Only'!R[2]C[-2]"
Range("C4").Select
End Sub

显然,重复180次这将是愚蠢的。这是我已经复制的表格宏:

Sub CopySheet()

Call OptimizeCode_Begin

Dim x As Integer

x = InputBox("Enter number of times to copy active sheet")
For numtimes = 1 To x
   'Loop by using x as the index number to make x number copies
   ActiveWorkbook.ActiveSheet.Copy _
      After:=ActiveWorkbook.Sheets(3)
      'Put copies in front of Sheet3
      'Might need to move the new sheets

Next

Call OptimizeCode_End

End Sub

我想要做的是要么嵌入一个嵌套循环,要么自动推进每个工作表的R1C1公式,这样我就不必在单元格中输入我试图在所有工作表之后引用复制。任何帮助将不胜感激。

谢谢!

贾斯汀

2 个答案:

答案 0 :(得分:0)

可能就是你所追求的:

Option Explicit

Sub CopySheet()
    Dim numtimes As Long, x As Long, rowIndex As Long

    Call OptimizeCode_Begin
    rowIndex = 4 '<-- this is the row index that will be used in the formula that'll be written in the first new sheet
    numtimes = Application.InputBox("Enter number of times to copy active sheet", Default:=1, Type:=1)
    For x = 1 To numtimes
        'Loop by using x as the index number to make x number copies
        ActiveWorkbook.ActiveSheet.Copy _
        After:=ActiveWorkbook.Sheets(3)
        Range("C3").Formula = "='Dividing Walls Only'!A" & rowIndex '<--| write formula in the new sheet cell "C3" referencing "Dividing Walls Only" worksheet column "A" cell in current 'rowIndex'
        rowIndex = rowIndex + 1 '<--| update row index for subsequent new sheet formula
    Next
    Call OptimizeCode_End
End Sub

你看我使用 Excel (即ApplicationInputBox()方法代替 VBA InputBox()一个,因为前者让你同时指定返回数据类型(类型:= 1表示数字输入),从而强制用户输入所需的数据。

答案 1 :(得分:0)

从我的帖子中我可以理解,下面的代码将根据用户在InputBox中选择的次数运行,并在最后一次打开后复制一张。

对于每个创建的工作表,它会将公式添加到单元格C4 ,我只是不确定推进每张工作表的公式的逻辑。

Sub CopySheets()

Dim x           As Long
Dim numtimes    As Long
Dim newSht      As Worksheet


x = Application.InputBox("Enter number of times to copy active sheet", Default:=1, Type:=1)

' optimize run time
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False

' create the Buttons on the original sheet
' (will be copied inside the loop for all other sheets)
ActiveSheet.Buttons.Add(541.5, 97.5, 95.25, 43.5).Select
ActiveSheet.Buttons.Add(541.5, 169.5, 94.5, 42.75).Select

For numtimes = 1 To x

    'Loop by using x as the index number to make x number copies
     ActiveWorkbook.ActiveSheet.Copy _
            After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

    Set newSht = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

    ' give the new Sheet Name the reference of num of times
    newSht.Name = "<NULL " & numtimes & ">"

    ' advance the row number in the formula
    newSht.Range("C3").FormulaR1C1 = "='Dividing Walls Only'!R[" & numtimes & "1]C[-2]"

Next numtimes

' Resume Settings
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub