也许我已经盯着这个太久了,但我有一个宏可以在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公式,这样我就不必在单元格中输入我试图在所有工作表之后引用复制。任何帮助将不胜感激。
谢谢!
贾斯汀
答案 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 (即Application
)InputBox()方法代替 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