查找文本并插入范围 上方 7 行并向下移动

Question

---

你好，我在一列中有一个重复出现的文本，上面写着:">"command" 16日,">

每次该文本出现时，我都要在

上面插入一个来自工作表2,7行的集合范围我有这个代码，但不能让它工作。任何想法

Sub Find_Insert()
Application.ScreenUpdating = False
Dim m As Long
Dim Lastrow2 As Long
Sheets("servo commands").Range("B1:B192").Copy 'sheet with set range to copy
Worksheets("Import").Activate
Lastrow2 = Cells(Rows.Count, "A").End(xlUp).Row
For m = Lastrow2 To 1 Step -1
If Cells(m, "A").Value = "                ""command"": 16," Then Cells(m, "A").Offset(-7, 0).Select
Selection.Insert Shift:=xlDown
Next
Application.ScreenUpdating = True
End Sub

many thanks in advance

Answer 1

Insert Range With Offset

Sub InsertCells()

Const DST_ROW_OFFSET As Long = 7
Const DST_CRIT_STRING As String = "                ""command"": 16,"

Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Sheets("Servo Commands")
Dim srg As Range: Set srg = sws.Range("B1:B192")

Dim dws As Worksheet: Set dws = wb.Sheets("Import")
Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

Dim dr As Long, dString As String

For dr = dlRow To DST_ROW_OFFSET + 1 Step -1
dString = CStr(dws.Cells(dr, "A").Value)
If StrComp(dString, DST_CRIT_STRING, vbTextCompare) = 0 Then
srg.Copy
dws.Cells(dr, "A").Offset(-DST_ROW_OFFSET).Insert Shift:=xlShiftDown
dr = dr - DST_ROW_OFFSET
End If
Next dr

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Cells inserted."
End Sub