EXCEL VBA, вставка пустой строки и перемещение ячеек
у меня возникли проблемы с вводом всей пустой строки. Я пытаюсь сдвинуть столбцы A-AD (четыре столбца после Z).
В настоящее время ячейки A-O имеют содержимое. Ячейки O-AD пусты. Но я запускаю макрос, чтобы поместить данные справа от текущих данных (столбец O).
Я могу вставить строку с помощью
dfind1.Offset(1).EntireRow.Insert shift:=xlDown
но, похоже, он только смещается вниз от A-O. мне удалось сдвинуть O-AD, используя цикл for
dfind1 as Range
For d = 1 To 15
dfind1.Offset(2, (d + 14)).Insert shift:=xlDown
Next d
есть ли способ сдвинуть вниз 30 ячеек против 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
1 ответов
Если вы хотите просто переложить все вниз, вы можете использовать:
Rows(1).Insert shift:=xlShiftDown
аналогично перенести все:
Columns(1).Insert shift:=xlShiftRight