遍历列中的单元格，如果包含标准，则将行复制到新工作表

我有一个类似于以下的电子表格：

 名称标题ID
人1标题1 1
人2标题2 11
人3标题3 111
人4标题4 1111
人5标题5 12
人6标题6 121
人7标题7 1211
人8标题8 1212
人9标题9 122
人10标题10 13
人11标题11 131
人12标题12 1311
人13标题13 1312
人14标题14 13121
人15标题15 1313
人16标题16 132
人17标题17 1321
人18标题18 14
人19标题19 15
人20标题20 151
人21标题21 1512

我想遍历“ID”列中的每个单元格。 如果该列包含值，则将整行复制到新工作表。

这是棘手的部分：

  - 第一个数字总是以1开始。 
  - 我想要脚本search“ID”1 +另一个数字（10,11,12,13 ...）。 
   对于符合条件的所有单元格将该行复制到新工作表。 
  - 完成后，现在search11 +另一个数字（111,112,113,114 ...）。 
  - 完成后，现在search12 +另一个数字（121,122,123,124 ...）

这应该继续下去：

search“ID”为：查找所有：
     19 191,192,193,194 ...
     124 1241，1242，1243，1244 ...
     1111 11111，11112，11113，11114，11115 ...
     1127 11271,11272,11273,11274 ... 
     12345 123451，123452，123453，123454，123455 ...

“+另一个单独的数字”之前的前面的数字指示了它应该进入的表格。

  - 如果search1 +另一个数字 - 这些都应该在一张纸上。
  - 如果search11 +另一个数字 - 这些应该在一张纸上。
  - 如果search1234 +另一个数字 - 这些应该在一张纸上。
  - 等等等等。

Answer 1

我意识到我应该在提问之前发布我的尝试。 无论如何，我想出了如何做到这一点。 我是新来的VBA，但这工作：

Set mainSht = Worksheets("Sheet1") ' Copy From this sheet 'Find the last row with data in specified column. LR = mainSht.Cells(Rows.Count, "F").End(xlUp).Row Set LRange = mainSht.Range("F2:F" & LR) 'Find max number in the range max = Application.WorksheetFunction.max(LRange) 'Look at every cell in cpecified column For Each Cell In LRange For i = 1 To max cIndex = CStr(i) If Cell.Value Like "1" + cIndex + "?" Then 'check to See if C equals value sheetName = "1" + cIndex 'Check if worksheet exists Set wsCheck = Nothing On Error Resume Next Set wsCheck = ActiveWorkbook.Worksheets(sheetName) On Error GoTo 0 'If worksheet does not exist, create new If wsCheck Is Nothing Then Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = sheetName End If Set Pastesheet = Worksheets(sheetName) ' Paste to this sheet Cell.EntireRow.Copy ' Copy the row Pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats End If Next Next Cell ' Now we check the next cell in chosen column