Sub FillData() Dim ws1 As Worksheet, ws2 As Worksheet Dim lastRow1 As Long, lastRow2 As Long Dim i As Long, j As Long Dim dateValue As Date Dim isDateFound As Boolean

Set ws1 = ThisWorkbook.Worksheets('Sheet1')
Set ws2 = ThisWorkbook.Worksheets('Sheet2')

lastRow1 = ws1.Cells(ws1.Rows.Count, 'A').End(xlUp).Row

For i = 2 To lastRow1
    dateValue = ws1.Cells(i, 1).Value
    isDateFound = False
    
    For j = 2 To ws2.Rows.Count Step 10
        lastRow2 = ws2.Cells(j, 'A').End(xlUp).Row
        
        If lastRow2 < j + 9 Then
            If j = 2 Or ws2.Cells(j - 1, 'A').Value <> dateValue Then
                ws2.Cells(j, 'A').Value = dateValue
                ws1.Range(ws1.Cells(i, 2), ws1.Cells(i, ws1.Columns.Count)).Copy _
                    Destination:=ws2.Range(ws2.Cells(j + 1, 2), ws2.Cells(j + 9, ws2.Columns.Count))
                isDateFound = True
                Exit For
            End If
        End If
    Next j
    
    If Not isDateFound Then
        MsgBox 'Data for ' & dateValue & ' cannot be added to Sheet2.'
    End If
Next i

MsgBox 'Data filling completed.'

End Sub

Excel VBA: Fill Data from One Sheet to Another Based on Date

原文地址: https://www.cveoy.top/t/topic/lDQ2 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录