EXCEL VBA，插入空白行並移動單元格

Question

我無法輸入整個空白行。我試圖改變列A-AD（四列Z）。

當前單元格A-O包含內容。單元格O-AD是空白的。但是我正在運行一個宏來將數據放在當前數據的右側（列O）。

我可以插入使用

dfind1.Offset(1).EntireRow.Insert shift:=xlDown 

行，但似乎只從A-O下移。我管理使用for循環

dfind1 as Range 
For d = 1 To 15 
    dfind1.Offset(2, (d + 14)).Insert shift:=xlDown 
Next d 

有沒有辦法來30個細胞VS 15下移下移O型AD？同樣，我想將15移到右邊的單元格。目前我有另一個for循環設置。

至於其餘的代碼，它的下面。基本上合併兩個Excel表基於在A列中找到一個匹配。我已經標記了問題區域。其餘的代碼大部分工作。

Sub combiner() 

    Dim c As Range, d As Long, cfind As Range, x, y, zed, dest As Range, cfind1 As Range, dfind As Range, _ 
    dfind1 As Range, crow, x_temp, y_temp 

    On Error Resume Next 
    Worksheets("sheet3").Cells.Clear 
    With Worksheets("sheet1") 
    .UsedRange.Copy Worksheets("sheet3").Range("a1") 
    End With 

    With Worksheets("sheet2") 
    For Each c In Range(.Range("a3"), .Range("a3").End(xlDown)) 
    x = c.Value 
    y = c.Next 

    Set cfind = .Cells.Find(what:=y, lookat:=xlWhole) 
    .Range(cfind.Offset(0, -1), cfind.End(xlToRight)).Copy 

     With Worksheets("sheet3") 
      Set dfind1 = .Cells.Find(what:=x, lookat:=xlWhole) 
      If dfind1 Is Nothing Then GoTo copyrev 

      '************************************************************** 
      '************************************************************** 
      'This is the problem Area 
      'I'm basically having trouble inserting a blank row 
      dfind1.Offset(1).EntireRow.Insert shift:=xlDown 



      For d = 1 To 15 
       dfind1.Offset(1).Insert shift:=xlToRight 
      Next d 

      For d = 1 To 15 
       dfind1.Offset(2, (d + 14)).Insert shift:=xlDown 
      Next d 
      '************************************************************** 
      '************************************************************** 


     End With 'sheet3 
     GoTo nextstep 

    copyrev: 
     With Worksheets("sheet3") 
      x_temp = .Cells(Rows.Count, "A").End(xlUp).Row 
      y_temp = .Cells(Rows.Count, "P").End(xlUp).Row 
      If y_temp > x_temp Then GoTo lr_ed 
      lMaxRows = x_temp 
      GoTo lrcont 
    lr_ed: 
      lMaxRows = y_temp 
    lrcont: 
      .Range(("P" & lMaxRows + 1)).PasteSpecial 
      Worksheets("sheet2").Range(cfind.Offset(0, -1), cfind.Offset(0, 0)).Copy 
      .Range(("A" & lMaxRows + 1)).PasteSpecial 
     End With 'sheet3 


    nextstep: 
    Next 


    lngLast = Range("A" & Rows.Count).End(xlUp).Row 

    With Worksheets("Sheet3").Sort 
     .SortFields.Clear 
     .SortFields.Add Key:=Range("A1:A2" & lngLast), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .SetRange Range("B3:Z" & lngLast) 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 


    End With 'sheet2 
     Application.CutCopyMode = False 
End Sub 

Answer 1

如果你只想轉移都記錄下來，你可以使用：

Rows(1).Insert shift:=xlShiftDown 

同樣轉移所做的一切：如果這個問題是非常非常短

Columns(1).Insert shift:=xlShiftRight