我每个月都有一个电子表格,每月每天有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
答案 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