如果单元格包含关键字，则复制并插入范围

Question

我对VB Macro中的Excel不熟悉。我在excel中有很多关于问题和他们的问题的数据，不幸的是它的格式很差。我正在组织问题和答案。

如果列Copy的单元格Range包含关键字i，我正在尝试N Question。如果列N的单元格包含关键字"Question"，那么我需要copy Range从cell到cell column N Column Y到Range(i+1, N : i+9, Y)。所以，我的复制范围是Range。一旦复制，我需要在eighth cell Column A之后插入具有关键字"Question"的{​​{1}}。所以，我插入的Range是Range(i+9, A : i+17, A)。

我尝试了以下代码，但它不起作用。所以，我真的很感激任何有关这方面的帮助。以下是我的代码：

Sub OrganizingQuestion()
Dim iRow As Integer
Dim que As String
Dim rng As Range
Dim rng2 As Range
For iRow = 1 To Range("N" & "5000").End(xlUp).Row Step 1
   If Cells(iRow, 14) = "Question" Then
     Set rng = Range("N" & iRow + 1 & ":Y" & iRow + 9)
     rng.Copy
   End If

   If Cells(iRow, 1) = "Question" Then
      Set rng2 = Range("A" & iRow + 9 & ":A" & iRow + 18)
      rng2.EntireRow.Insert Shift:=xlDown, CopyOrigin:=rng
   End If
Next iRow
End Sub

Answer 1

CopyOrigin采用XlInsertFormatOrigin枚举值。我从不使用它。

Sub OrganizingQuestion()
    Dim iRow As Integer

    For iRow = 1 To Range("N" & Rows.Count).End(xlUp).Row Step 1

        If Cells(iRow, 14) = "Question" And Cells(iRow, 1) = "Question" Then
            Range("N" & iRow + 1 & ":Y" & iRow + 9).Copy
            Range("A" & iRow + 9 & ":A" & iRow + 18).Insert Shift:=xlDown
        End If

    Next iRow
End Sub