EXCEL VBA,插入空行和移动单元格

进入整个空白行时遇到问题。 我正试图移动列A-AD(四列Z)。

目前单元格AO有内容。 单元格O-AD是空白的。 但是我正在运行一个macros来把数据放在当前数据的右边(O列)。

我可以使用插入一行

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

但它似乎只是从AO向下移动。 我设法使用for循环将O-AD向下移动

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

有没有办法将30个单元格移到VS 15? 同样,我想把15移到右边的单元格。 目前我有另一个循环设置。

至于其余的代码,下面。 基本上合并两个Excel表基于在列A中find一个匹配。我已经标记了问题区域。 其余的代码大部分工作。

 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 

如果你想把所有东西都转移下来,你可以使用:

 Rows(1).Insert shift:=xlShiftDown 

类似的把所有的东西都转移到

 Columns(1).Insert shift:=xlShiftRight