Я работаю над электронной таблицей, которая генерирует строки на других листах на основе ячейки на первом листе. После того, как все это заработало и доработало все динамические формулы c, я обнаружил, что последняя ячейка требует другого набора формул, и теперь мой оригинальный скрипт VBA не работает. Мой оригинальный скрипт только что добавил новые строки в конце, теперь ему нужно вставить новые ячейки в строку 7, сдвинув эту строку вниз и скопировав строку 6 во все вновь созданные ячейки.
Вот мой оригинальный скрипт ..
Private Sub CommandButton1_Click()
' This routing will copy rows based on the quantity to a new sheet.
Dim rngSinglecell12 As Range
Dim rngQuantityCells12 As Range
Dim rngSinglecell467 As Range
Dim rngQuantityCells467 As Range
Dim rngSinglecell358 As Range
Dim rngQuantityCells358 As Range
' Set this for the range where the Quantity column exists. This works only if there are no empty cells
Set rngQuantityCells12 = Range("G9", Range("G9").End(xlDown))
Set rngQuantityCells467 = Range("D9", Range("D9").End(xlDown))
Set rngQuantityCells358 = Range("F9", Range("F9").End(xlDown))
For Each rngSinglecell12 In rngQuantityCells12
'Check if this cell actually contains a number and if the number is greater than 0
If IsNumeric(rngSinglecell12.Value) And rngSinglecell12.Value > 0 Then
Sheets("Line 1").Rows("6").Copy (Sheets("Line 1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell12.Value + 1))
Sheets("Line 2").Rows("6").Copy (Sheets("Line 2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell12.Value + 1))
End If
Next
For Each rngSinglecell467 In rngQuantityCells467
' Check if this cell actually contains a number and if the number is greater than 0
If IsNumeric(rngSinglecell467.Value) And rngSinglecell467.Value > 0 Then
Sheets("Line 4").Rows("6").Copy (Sheets("Line 4").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell467.Value + 1))
Sheets("Line 6").Rows("6").Copy (Sheets("Line 6").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell467.Value + 1))
Sheets("Line 7").Rows("6").Copy (Sheets("Line 7").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell467.Value + 1))
End If
Next
For Each rngSinglecell358 In rngQuantityCells358
' Check if this cell actually contains a number and if the number is greater than 0
If IsNumeric(rngSinglecell358.Value) And rngSinglecell358.Value > 0 Then
Sheets("Line 3").Rows("6").Copy (Sheets("Line 3").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell358.Value + 1))
Sheets("Line 5").Rows("6").Copy (Sheets("Line 5").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell358.Value + 1))
Sheets("Line 8").Rows("6").Copy (Sheets("Line 8").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell358.Value + 1))
End If
Next
End Sub
Я предполагаю, что это будет что-то вроде этого
Rows("6:6").Select
Selection.Copy
Rows("7:7").Select
Selection.Insert Shift:=xlDown
, но я не уверен, как действительно включить это в сценарий, который у меня есть, или если есть лучший способ .