我无法输入整个空白行。我正在尝试移动 A-AD 列(Z 之后的四列)。
目前,单元格 AO 有内容。单元格 O-AD 为空白。但是我正在运行一个宏来将数据放在当前数据的右侧(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 移到右侧的单元格。目前我有另一个 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