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

Question

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

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

当我运行它时，它会将第一行留空，当我插入新数据并运行它时，它再次完全按照我的意愿将所有内容向下移动它，但它不会填充空单元格 - 它只是从第 17 行开始，因为在 worksheet Opgørsel 中我有 17 行填充了数据 - 我不知道，为什么它会那样跳。
在 sheet opgørsel 中，我在单元格 D3 中有 12 个选项，根据选择的选项，我希望它将它复制到那个 sheet - 我也制作了 12 sheets - 但我不知道如何制作它。

.

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 将目标复制到另一个 sheet 的内容。我希望随着您提供更多详细信息，这将不得不进一步完善。这假设 D3 持有一个有效的 sheet 名称来复制到。它不断地从源 sheet 获取所有内容，因此您最终会得到重复的数据。如果您只想传输新行，那么您需要在某处跟踪行数（可能在另一个 sheet 中）。

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

示例：

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

Copy to other worksheets depending on criteria

excel

vba

criteria

copy-paste