複製整個行如果單元格包含

Question

我試圖自動化插入行並複製如果單元格中有「（4 SHEETS）」單元格A例如。我不知道如何開始這個。

如果aCell包含「（x SHEETS）」，則在aCell下插入x行。複製一個Cell。將變量粘貼到x行中。 Next

最終我想「（x SHEETS）」也被重命名。因此， 「（4張）」 將變成4行與 「（4張）」 被修改爲 「（第1頁）」， 「（第2頁）」 等

感謝您的幫助

Answer 1

假設aCell位置在A1（單元地址[1,1]）中，然後獲取aCell值，從aCell值中提取數字，然後根據aCell值創建行數。

Sub Main() 

    Dim aCell As String 
    Dim ws As Worksheet 
    Dim i As Long 
    Dim noOfSheet As String 

    Set ws = ThisWorkbook.Sheets("Sheet1") 
    aCell = ws.Cells(1, 1).Value 

    'Extract the no. of sheets from the cell 
    For i = 1 To Len(aCell) 
     If Mid(aCell, i, 1) >= "0" And Mid(aCell, i, 1) <= "9" Then 
      noOfSheet = noOfSheet + Mid(aCell, i, 1) 
     End If 
    Next 

    'Insert no. of row based on the no. of sheets 
    If CInt(noOfSheet) > 0 Then 
     For i = 1 To CInt(noOfSheet) 
      ws.Cells(1, 1).Offset(1, 0).EntireRow.Insert 
      ws.Cells(1, 1).Offset(1, 0).Value = "(SHEET " & CInt(noOfSheet) + 1 - i & ")" 
     Next i 
    End If 

End Sub