如何复制工作表,调整值,然后填充新的工作表?



我有一个宏,通过复制原始工作簿中的工作表来生成动态数量的新工作簿。

在分步传递模式下,复制的工作表中的值在循环中根据两个输入正确调整,并填充到新的工作表中。
正常运行时,所有新工作簿都包含原始值。

我知道使用.Select是不好的。我不知道如何解决这个问题。

Sub create_jvs()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim achWS, refWS As Worksheet
Dim refRng, strtCell As Range
Dim j, fRow, lRow As Integer
Set refWS = wb.Sheets("References")
Set achWS = wb.Sheets("ACHLinkage")
'get first and last row of constraint range in ACHLinkage
fRow = 2
lRow = achWS.Columns("AB").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, 
LookIn:=xlValues).Row
'loop to produce separate ach jvs
For j = -29 To (-29 + (lRow - fRow)) Step 1

ThisWorkbook.Sheets("References").Activate       'select the ref worksheet
refWS.Range("R31").Select                        'select the first reference cell 

'update formula 1
ActiveCell.FormulaR1C1 = "=IF(ACHLinkage!R[" & j & "]C[10] = """",  """", 
IF(ACHLinkage!R[" & j & "]C[10]=""N"",ROUNDDOWN(References!R30C19*ACHLinkage!R[" & j & 
"]C[11],2),ROUNDUP(References!R30C19*ACHLinkage!R[" & j & "]C[11],2)))"

ActiveCell.Offset(1).Select

'update formula 2
ActiveCell.FormulaR1C1 = "=IF(ACHLinkage!R[" & j - 1 & "]C[10] = """", """", 
IF(ACHLinkage!R[" & j - 1 & "]C[10] = ""N"", ROUNDDOWN(References!R28C19*ACHLinkage!R[" & 
j - 1 & "]C[11],2), ROUNDUP(References!R28C19*ACHLinkage!R[" & j - 1 & "]C[11],2)))"

ActiveCell.Offset(1).Select

'update formula 3
ActiveCell.FormulaR1C1 = "=IF(ACHLinkage!R[" & j - 2 & "]C[10] = """", """", 
IF(ACHLinkage!R[" & j - 2 & "]C[10]=""N"",ROUNDDOWN(USERFORM!R26C6*ACHLinkage!R[" & j - 2 
& "]C[11],2),ROUNDUP(USERFORM!R26C6*ACHLinkage!R[" & j - 2 & "]C[11],2)))"

ActiveCell.Offset(1).Select

'update formula 4
ActiveCell.FormulaR1C1 = "=IF(ACHLinkage!R[" & j - 3 & "]C[10] = """", """", 
IF(ACHLinkage!R[" & j - 3 & "]C[10]=""N"",ROUNDDOWN(USERFORM!R26C7*ACHLinkage!R[" & j - 3 
& "]C[11],2),ROUNDUP(USERFORM!R26C7*ACHLinkage!R[" & j - 3 & "]C[11],2)))"

ActiveCell.Offset(1).Select

'update formula 5
ActiveCell.FormulaR1C1 = "=IF(ACHLinkage!R[" & j - 4 & "]C[10] = """", """", 
IF(ACHLinkage!R[" & j - 4 & "]C[10]=""N"",ROUNDDOWN(USERFORM!R26C8*ACHLinkage!R[" & j - 4 
& 
"]C[11],2),ROUNDUP(USERFORM!R26C8*ACHLinkage!R[" & j - 4 & "]C[11],2)))"

ThisWorkbook.Sheets("ACH JV").Copy   'copy jvWS to new wb

Next j
End Sub

我认为ACH JV引用了参考文献。当您复制ACH JV时,您也复制了公式,它们继续引用参考文献-它们都指向参考文献中的相同单元格。当您更改这些单元格时,您也在更改每个生成的工作簿。当您逐步完成时,它似乎有效,因为您正在查看副本后生成的每个工作簿。如果您在逐步执行时查看以前的工作簿,它看起来就像当前的工作簿。

如果我是正确的,您需要在每次复制后将这些公式转换为值。示例代码如下:

Sub create_jvs()
Dim achWS, refWS As Worksheet
Dim j As Long, lRow As Long, fRow As Long
Dim rCell As Range

Set refWS = ThisWorkbook.Sheets("References")
Set achWS = ThisWorkbook.Sheets("ACHLinkage")
Set rCell = refWS.Range("R31")

'get first and last row of constraint range in ACHLinkage
fRow = 2
lRow = achWS.Columns("AB").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row

'loop to produce separate ach jvs
For j = -29 To (-29 + (lRow - fRow)) Step 1

rCell.FormulaR1C1 = "=IF(ACHLinkage!R[" & j & "]C[10] = """",  """", IF(ACHLinkage!R[" & j & "]C[10]=""N"",ROUNDDOWN(References!R30C19*ACHLinkage!R[" & j & "]C[11],2),ROUNDUP(References!R30C19*ACHLinkage!R[" & j & "]C[11],2)))"
rCell.Offset(1).FormulaR1C1 = "=IF(ACHLinkage!R[" & j - 1 & "]C[10] = """", """", IF(ACHLinkage!R[" & j - 1 & "]C[10] = ""N"", ROUNDDOWN(References!R28C19*ACHLinkage!R[" & j - 1 & "]C[11],2), ROUNDUP(References!R28C19*ACHLinkage!R[" & j - 1 & "]C[11],2)))"
rCell.Offset(2).FormulaR1C1 = "=IF(ACHLinkage!R[" & j - 2 & "]C[10] = """", """", IF(ACHLinkage!R[" & j - 2 & "]C[10]=""N"",ROUNDDOWN(USERFORM!R26C6*ACHLinkage!R[" & j - 2 & "]C[11],2),ROUNDUP(USERFORM!R26C6*ACHLinkage!R[" & j - 2 & "]C[11],2)))"
rCell.Offset(3).FormulaR1C1 = "=IF(ACHLinkage!R[" & j - 3 & "]C[10] = """", """", IF(ACHLinkage!R[" & j - 3 & "]C[10]=""N"",ROUNDDOWN(USERFORM!R26C7*ACHLinkage!R[" & j - 3 & "]C[11],2),ROUNDUP(USERFORM!R26C7*ACHLinkage!R[" & j - 3 & "]C[11],2)))"
rCell.Offset(4).FormulaR1C1 = "=IF(ACHLinkage!R[" & j - 4 & "]C[10] = """", """", IF(ACHLinkage!R[" & j - 4 & "]C[10]=""N"",ROUNDDOWN(USERFORM!R26C8*ACHLinkage!R[" & j - 4 & "]C[11],2),ROUNDUP(USERFORM!R26C8*ACHLinkage!R[" & j - 4 & "]C[11],2)))"

ThisWorkbook.Sheets("ACH JV").Copy   'copy jvWS to new wb

'Turn formulas into values
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

Next j
End Sub

最新更新