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

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

示例：