用于插入列和粘贴数据的VBA代码-更改日期值

我遇到了一个路障，无法解决这个问题

我有一张表，有9列，每列都有一个标题。其中2列有开始日期和结束日期。第10列，我用开始日期减去结束日期，得到天数。这些值可以是0（仅1天）到5之间的任意值

我正在尝试做一个VBA代码，它将检查第10列（第J列）并引用该数字，在它的正下方插入一行，同时也包含它所包含的信息

我有下面的代码，它将信息插入到Sheet2和添加的行中，并将数据复制到新行中

但我面临的问题是：

J3=4，然后在J3下插入4行，并从A3:I3复制数据，除了开始日期和结束日期之外，输入适当的日期

也就是说，假设开始日期为2013年1月1日，结束日期为2013年1月4日，那么

Sdate          Edate
1/1/2013    1/4/2013
1/2/2013    1/2/2013
1/3/2013    1/3/2013
1/4/2013    1/4/2013

这可能吗？我知道我可以将这些数据导入Access并执行追加查询，但我的工作不喜欢使用Access

这是有关插入行并将数据从所有10列复制到新列的代码：

Option Explicit

Sub BuildSortedSht()

Dim sht As Worksheet
Dim rng As Range
Dim IP As Range
Dim LastRow As Integer
Dim i As Integer
Dim scell As Variant


LastRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row

Set sht = Application.ThisWorkbook.Worksheets("Sheet2")
Set rng = Sheets("Sheet1").Range("J2:J" & LastRow)
Set IP = sht.Range("A2")

For Each scell In rng

If scell > 1 Then

  For i = 1 To scell

    Range(scell.Offset(0, -9), scell.Offset(0, 1)).Copy
    IP.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
                  SkipBlanks:= False, Transpose:=False

    Set IP = IP.Offset(1, 0)

  Next i

Else

    Range(scell.Offset(0, -9), scell.Offset(0, 1)).Copy
    IP.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
               SkipBlanks:= False, Transpose:=False

    Set IP = IP.Offset(1, 0)

End If

Next

End Sub

---

如果我理解正确，您的代码应该如下所示：

Dim MyDate As Date
Dim LastRow As Long
Dim i As Long
Dim j As Long

With Sheets("Sheet1")
    LastRow = .Range("A" & Rows.Count).End(xlUp).Row

    For i = LastRow To 2 Step -1    'as you insert new rows that shift data, you have to go in a loop up: from bottom to top
        If .Cells(i, "J") > 0 Then
            .Rows(i + 1 & ":" & i + .Cells(i, "J")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            'copy range(s) you want from row above
            .Range(.Cells(i + 1, "A"), .Cells(i + .Cells(i, "J"), "I")).Value = .Range(.Cells(i, "A"), .Cells(i, "I")).Value

            'create start:end dates in columns A:B (A = start date)
            MyDate = .Cells(i, "A")
            For j = i + 1 To i + .Cells(i, "J")
                MyDate = DateAdd("d", 1, MyDate)
                .Range(.Cells(j, "A"), .Cells(j, "B")) = MyDate
            Next j
        End If
    Next i
End With

---

您能否整理一下您的问题，只提供所需的最低信息，并更具体地说明您打算生成的输入和输出？此外，还有一种更简洁的方法，可以实现与

LastRow=Sheets（“Sheet1”）。范围（“A65536”）。结束（xlUp）。行
将是
Sheets（“Sheet1”）.UsedRange.Rows.Count
使用声明
Dim LastRow作为Long
是一个好习惯，因为整数类型无法处理Excel中的所有行，总有一天这会影响您：）
Dim MyDate As Date
Dim LastRow As Long
Dim i As Long
Dim j As Long

With Sheets("Sheet1")
    LastRow = .Range("A" & Rows.Count).End(xlUp).Row

    For i = LastRow To 2 Step -1    'as you insert new rows that shift data, you have to go in a loop up: from bottom to top
        If .Cells(i, "J") > 0 Then
            .Rows(i + 1 & ":" & i + .Cells(i, "J")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            'copy range(s) you want from row above
            .Range(.Cells(i + 1, "A"), .Cells(i + .Cells(i, "J"), "I")).Value = .Range(.Cells(i, "A"), .Cells(i, "I")).Value

            'create start:end dates in columns A:B (A = start date)
            MyDate = .Cells(i, "A")
            For j = i + 1 To i + .Cells(i, "J")
                MyDate = DateAdd("d", 1, MyDate)
                .Range(.Cells(j, "A"), .Cells(j, "B")) = MyDate
            Next j
         End If
     Next i
End With