Sub FillData()

Dim ws1 As Worksheet, ws2 As Worksheet Dim lastRow As Long, lastCol As Long Dim dateCol As Long Dim i As Long, j As Long, k As Long Dim currDate As Date, prevDate As Date

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

lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row lastCol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column dateCol = 1 'Assuming date is in column A

prevDate = ws1.Cells(2, dateCol).Value 'Assuming row 1 is header

k = 4 'Starting row of first table in Sheet2

For i = 2 To lastRow 'Loop through rows in Sheet1

currDate = ws1.Cells(i, dateCol).Value

If currDate <> prevDate Then 'If new date, move to next table

    k = k + 10 'Move to next table
    prevDate = currDate 'Update previous date

End If

'Loop through columns and copy data to Sheet2
For j = 1 To lastCol
    ws2.Cells(k, j).Value = ws1.Cells(i, j).Value
Next j

'Check if table is full and move to next table
If k + 7 > (k \ 10) * 10 + 10 Then
    k = (k \ 10) * 10 + 14 'Move to next table
    prevDate = currDate 'Update previous date
End If

Next i

End Sub

Excel VBA 自动化工具:将数据从工作簿1填充到工作簿2的多个表格中

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

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