根据条件复制到其他工作表

Question

我是 VBA 的新手并且被卡住了。我在这里看过一些 Youtube 视频和一些主题，但这对我来说很复杂 - 我希望你们中的一些人能帮助我:)

我使用下面的宏并遇到了这些障碍。

1. 当我运行它时，它会将第一行留空，当我插入新数据并运行它时，它再次按照我的意愿将所有内容完美地向下移动，但它不会填充空单元格 - 它只是从第 17 行开始，因为在工作表 Opgørsel 我有 17 行填充了数据 - 我不知道，为什么它会那样跳跃。

2. 在工作表 opgørsel 中，我在单元格 D3 中有 12 个选项，根据选择的选项，我希望它复制到该工作表 - 我也制作了 12 个工作表 - 但我没有知道如何做到这一点。

.

Sub Copypastemeddata()
    Worksheets("Opgørsel").Activate
    Range("A1").CurrentRegion.Copy
    Worksheets("Opsamling").Activate
    Range("A1").PasteSpecial
    Range("A1").PasteSpecial xlPasteValues
    Range("A1").PasteSpecial xlPasteColumnWidths
    Selection.Insert Shift:=xlDownenter
End Sub

Answer 1

以下是使用 D3 将目标复制到另一张纸的情况。我希望随着您提供更多细节，这将不得不进一步完善。这假设 D3 持有一个有效的工作表名称以复制到。它不断地从源表中获取所有内容，因此您最终会得到重复的数据。如果您只想传输新行，则需要在某处（可能在另一张表中）跟踪行数。

Option Explicit

Sub Copypastemeddata()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sourceCell As Range
    Dim targetSheet As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Opgørsel")

    Set sourceCell = ws.Range("D3")  'Cell with sheet names for copying to

    With ws

          Set targetSheet = wb.Worksheets(sourceCell.Text)

          Dim nextRow As Long
          nextRow = GetLastRow(targetSheet, 1)
          nextRow = IIf(nextRow = 1, 1, nextRow + 1)

         .Range("A1").CurrentRegion.Copy targetSheet.Range("A" & nextRow)

    End With

End Sub


Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long

    With ws

      GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row

    End With

End Function

例子：