VBA代码移动列并保持公式

大家好,这是我的代码:

Sub Biz1_Shift_OnePeriod() 'Shift all values one period to the left 'Message Box Question Ans = MsgBox("Update data by one year?", vbYesNo + vbQuestion, "Data Update") If Ans = vbNo Then Exit Sub 'Turn off screen updating & calculation to make code run faster Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim CopyFromWks As Worksheet Dim CopyToWks As Worksheet Dim j As Integer Dim C As Range '--------------------------------------------------------------------- 'Business - Balance Sheet ' ' 'Set the worksheet Sheets("Balance Sheet").Select Range("A2").Select Set CopyToWks = Sheets("Balance Sheet") Set CopyFromWks = Sheets("Balance Sheet") ' 'Copy data loop from 2nd Historical to 3rd Historical Set Copyfrom = CopyFromWks.Range("L:L") Set Copyto = CopyToWks.Range("I:I") For i = 1 To 1 For j = 1 To 95 For Each C In Copyfrom.Cells(j, i) If C.Locked = False Then Copyto(j, i).Value = Copyfrom(j, i).Value End If Next Next Next ' 'Copy data loop from 1st Historical to 2nd Historical Set Copyfrom = CopyFromWks.Range("O:O") Set Copyto = CopyToWks.Range("L:L") For i = 1 To 1 For j = 1 To 95 For Each C In Copyfrom.Cells(j, i) If C.Locked = False Then Copyto(j, i).Value = Copyfrom(j, i).Value End If Next Next Next ' 'Set Historical Yr 1 to Zero Set Copyto = CopyToWks.Range("O:O") For i = 1 To 1 For j = 1 To 95 For Each C In Copyfrom.Cells(j, i) If C.Locked = False Then Copyto(j, i).Value = 0 End If Next Next Next ' 'Set Current equal to Zero Set Copyto = CopyToWks.Range("R:R") For i = 1 To 1 For j = 1 To 95 For Each C In Copyto.Cells(j, i) If C.Locked = False Then Copyto(j, i).Value = 0 End If Next Next Next 

我想要做的就是把我的专栏转移到左边。 我想复制粘贴方法会做,现在我有最后一列设置为0.但是,我需要最后一列保留所有的公式,但它不能从任何数据源拉。 我想出了一个想法,即创build另一个将被隐藏的列,并存储所有的公式,并在macros被触发时切换。 我想问你们是否有更好的方法来解决这个问题,并帮助一点点集体讨论。

尝试

 Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False