剪切并粘贴一组行以允许新的空白行

Question

我正在整理一个项目管理 excel 电子表格（我的公司不会为每个人支付许可来访问 MS Project 等任何东西，我想要每个人都可以使用的东西)，并希望用户能够在他们指定的任何地方添加或删除行（我正在使用用户表单以使其更易于使用）。我在复制、剪切和粘贴行以允许新的空白行时遇到问题。

我希望用户指定他们想要放置新行的行号（以及所有关联的公式和格式）。目前我正在使用 Cell "C6" 输入行号。我正在使用我之前成功使用过的修改后的代码变体，它允许我在电子表格的底部复制并粘贴一个新的空白行。我希望修改后的代码复制单元格 "C6" 中指定的行与最后一整行之间范围内的所有行，然后偏移一行并粘贴，例如如果第一行值为 14，最后一行为 50，则复制范围 (14:50)、偏移量到第 15 行并粘贴。

一旦我弄对了这一点，我就会将剩余的代码执行到 copy/paste 并清除第 14 行以给我一个新的空白格式行。我希望删除行的代码与此相反，但我稍后会谈到。

目前，我一直收到一个我不明白的错误 - 我已经尝试了我所知道的一切来解决这个问题，并进行了多次 Google 搜索，但没有任何效果！

错误一直突出显示 'FirstRow' 是一个问题，但单元格中有一个数字 - 我不知所措：

Dim rActive As Range
Dim FirstRow As Integer
Dim LastRow As Integer

Set rActive = ActiveCell

Application.ScreenUpdating = False

FirstRow = Range(Range("C6").Value)

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

With Range(FirstRow & ":" & LastRow)
.Copy

With Range(FirstRow).Offset(1, 0)
.PasteSpecial xlPasteAll

On Error Resume Next

End With

End With

rActive.Select

Application.CutCopyMode = False

Application.ScreenUpdating = True

我可以看到选择并复制了正确的范围，但后续偏移存在问题。

Answer 1

您的变量类型有误 FirstRow = Range(Range("C6").Value) 将 return 一个 RANGE OBJECT（实际上它会出错，因为没有 "set"）。

FirstRow = Range("C6")。值将 return 为整数或字符串。

++++++++++++++++++++++++++++++++++

我做过类似的事情，它不是最出色的代码，但也许它会给你一些想法。

Sub AddParticipant()

    Dim msgChoice As VbMsgBoxResult
    Dim NewName As String
    Dim TargetCell As Range

    'Set Up
    ThisWorkbook.Save

    If Range("LastParticipant").Value <> "" Then
        MsgBox "The roster is full. You cannot add anymore participants.", vbCritical
        Exit Sub
    End If

    'Get Name
    NewName = Application.InputBox( _
               Prompt:="Type the participant's name as you would like it to appear on 
                         this sheet.", _
               Title:="Participant's Name", _
               Type:=2)

        'Error Message
        If NewName = "" Then
            MsgBox ("You did not enter a name.")
            Exit Sub
        End If

    'Get Location (with Data Validation)
GetTargetCell:
    Set TargetCell = Application.InputBox _
           (Prompt:="Where would you like to put this person? (Select a cell in 
                 column A)", _
            Title:="Cell Select", _
            Type:=8)
    If TargetCell.Count > 1 Then
        MsgBox "Select a single cell in Column A"
        GoTo GetTargetCell
    End If

    If TargetCell.Column <> 1 Then
        MsgBox "Select a single cell in Column A"
        GoTo GetTargetCell
    End If

    If TargetCell.Offset(-1, 0) = "" Then
        MsgBox "You must pick a contiguous cell. No blank spaces allowed!"
        GoTo GetTargetCell
    End If


    If TargetCell <> "" Then

        'Do stuff to populate rows or shift data around

    Else
        'If they picked a blank cell, you can insert new data
        TargetCell.Value = NewName

    End If


End Sub

Answer 2

谢谢！！我对 'Range' 太自由了。现在的代码是：

Dim rActive 作为范围将 FirstRow 调暗为整数将 LastRow 调暗为整数

设置 rActive = ActiveCell

Application.ScreenUpdating = 假

FirstRow = Range("C6").Value

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

带范围（FirstRow & ":" & LastRow） .复制

有.Offset(1, 0) .PasteSpecial xlPasteAll

错误继续下一步

结尾为

rActive.Select

Application.CutCopyMode = 假

Application.ScreenUpdating = 真

效果很好！现在只需要完成剩下的事情...

剪切并粘贴一组行以允许新的空白行

Cut and paste a set of rows to allow a new blank row

excel

vba

xlsm