时间戳

首页 > 解决方案 > 将数据从一行复制到下一张表中的下一个可用行，循环

vba - 将数据从一行复制到下一张表中的下一个可用行，循环

问题描述

我几乎没有一般的编码经验，并且一直在 youtube 上观看视频以尝试编写一些代码。我有一个包含一堆数据的“主”表，我需要获取该数据并根据日期将其传输到每个连续的表中。因此，11 月 17 日到第 3 页的所有数据以及 11 月 18 日到第 4 表的所有数据，依此类推。我遇到的问题是当我尝试循环到下一个日期时。

Option Explicit

Sub Copypaste()

                        'Sets a as  variable for number of rows from master sheet
    a = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To a      'Loops from i=2 to end
        k = 3           'sheet number
        J = 43048       'date
        If Worksheets("Master").Cells(i, 1).Value = J Then
            Worksheets("Master").Rows(i).Copy
            Worksheets(k).Activate
                        'counts rows in sheet pasting to
            b = Worksheets(k).Cells(Rows.Count, 1).End(xlUp).Row
                        'pasts to next blank row
            Worksheets(k).Cells(b + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("Master").Activate
        Else
            k = k + 1
            J = J + 1
        End If
    Next

End Sub

标签： vbaexcel

解决方案

您必须将日期排除在循环之外，然后加一。

Sub Copypaste()

                        'Sets a as  variable for number of rows from master sheet
    a = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
    J = 43048       'date

    For i = 2 To a      'Loops from i=2 to end
        k = 3           'sheet number
        If Worksheets("Master").Cells(i, 1).Value = J Then
            Worksheets("Master").Rows(i).Copy
            Worksheets(k).Activate
                        'counts rows in sheet pasting to
            b = Worksheets(k).Cells(Rows.Count, 1).End(xlUp).Row
                        'pasts to next blank row
            Worksheets(k).Cells(b + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("Master").Activate
        Else
            k = k + 1
            J = J + 1
        End If
    Next

End Sub

因此上面的代码应该可以工作。如果您尝试将工作表声明为变量并避免Selectand Activate，代码会更快 - 如何避免在 Excel VBA 中使用 Select

因此，它看起来像这样：

Sub Copypaste()
    a = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To a
        k = 3
        J = 43048
        With Worksheets("Master")
            If .Cells(i, 1) = J Then
                .Rows(i).Copy
                b = Worksheets(k).Cells(Rows.Count, 1).End(xlUp).Row
                Worksheets(k).Cells(b + 1, 1).Paste
            Else
                k = k + 1
                J = J + 1
            End If
        End With
    Next

End Sub

第三步，您可以考虑编写普通的变量名。例如，代替awriterowsCountMaster和代替Jwrite currentDate。

推荐阅读