如何构建一个可以复制一系列单元格并插入具有新日期的行的宏?

时间:2016-07-13 16:15:16

标签: excel vba excel-vba macros

我每个月都有一个电子表格,每月每天有294行,不包括周末日期。我想要做的是能够复制每个星期五的行范围,并复制和粘贴每周丢失的星期六和星期日的数据。我找到了一个查找缺少日期的宏,并为这些日期插入一行,但不知道如何在更改日期时复制一系列单元格。

这是我在另一个主题中找到的宏,它为缺少日期添加了行。

Sub insertMissingDate()
Dim wks As Worksheet
Set wks = Worksheets("Sheet1")

Dim lastRow As Long
lastRow = wks.Range("C2").End(xlDown).Row

'Work bottom up since we are inserting new rows
For I = lastRow To 3 Step -1
    curcell = wks.Cells(I, 3).Value
    prevcell = wks.Cells(I - 1, 3).Value

    'Using a loop here allows us to bridge a gap of multiple missing dates
    Do Until curcell - 1 = prevcell Or curcell = prevcell
        'Insert new row
        wks.Rows(I).Insert x1ShiftDown

        'Insert missing date into new row
        curcell = wks.Cells(I + 1, 3) - 1
        wks.Cells(I, 3).Value = curcell
    Loop
Next I
End Sub

1 个答案:

答案 0 :(得分:1)

添加以下行:

wks.Rows(I - 1).Copy

在此之前:

wks.Rows(I).Insert xlShiftDown

更新(根据评论)

Sub AddDataWeekends()

    Dim lRow As Long
    lRow = Range("A" & Rows.Count).End(xlUp).Row

    Dim x As Long

    For x = lRow To 2 Step -294

        If Weekday(Cells(x, 1), vbSunday) = 6 Then
            Cells(x, 1).EntireRow.Copy
            Cells(x, 1).Resize(294 * 2).Insert xlShiftDown
            Cells(x + 1, 1).Resize(294).Value = Cells(x, 1) + 1
            Cells(x + 1, 1).Offset(294).Resize(294).Value = Cells(x, 1) + 2
        End If

    Next

End Sub