EXCEL VBA，插入空白行和移动单元格 [英] EXCEL VBA, inserting blank row and shifting cells

问题描述

我无法进入整个空白行。我正在尝试移动A-AD列（Z列四列）。

I'm having trouble entering an entire blank row. I'm trying to shift Columns A-AD (four columns past Z).

目前，单元格A-O有内容。细胞O-AD为空白。但是我正在运行一个宏来将数据放在当前数据的右侧（列O）。

Currently cells A-O has content. Cells O-AD are blank. But I'm running a macro to put data to the right of the current data (column O).

我可以使用

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

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

but it only seems to shift down from A-O. I've manage to shift down O-AD using a for loop

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

有没有办法向下移动30个细胞VS 15？同样，我想把15号移到右边的单元格。目前我还有一个for循环设置。

Is there a way to shift down 30 cells VS 15? Similarly, I want to shift 15 to the cells to the right. Currently I have another for loop setup for that.

对于其余的代码，它的下面。基本上合并两个excel表，以在A列中找到一个匹配。我已经标记了问题区域。其余代码大部分工作。

As for the rest of the code, its below. Basically merging two excel sheets bases on finding a match in column A. I've marked the problem area. The rest of the code works for the most part.

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

推荐答案

如果你想把所有的东西都移开，你可以使用：

If you want to just shift everything down you can use:

Rows(1).Insert shift:=xlShiftDown

同样转移一切：

Columns(1).Insert shift:=xlShiftRight

这篇关于EXCEL VBA，插入空白行和移动单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！