VBA復制粘貼整行僅復制第一個實例

Question

我目前正在編寫幾行 VBA 代碼。 我對這種語言很陌生，但是學習起來相對簡單。 我有這個程序，它將整行復制到同一工作簿中的另一張表，具體取決於是否發現此人的姓名（從假設表 1 中提取）在另一個電子表格（表 2）上。 然后使用部門（從表 1）將在表 2 上找到的名稱放在部門特定表上。

我遇到的問題是，它只打印條件的第一個實例，而在每個部門頁面上都沒有其他內容。

這是代碼，我將附上工作表的圖像以獲得更好的想法：主要：

Sub copy2Sheets()
   Dim table As Worksheet: Set table = Worksheets("Table")
   Dim N As Long
   N = 117
   Dim i As Long
   Dim tempDep As String
   Dim tempName As String
   
   tempDep = table.Cells(1, "B").value
   tempName = table.Cells(1, "A").value
   copyPaste tempName, Worksheets(Trim(tempDep))
   'Loop Case:
   For i = 2 To N - 1
       tempDep = table.Cells(i, "B").value
       tempName = table.Cells(i, "A").value
       copyPaste tempName, Worksheets(Trim(tempDep))
   Next i
   
End Sub

PasteFunction: 
Sub copyPaste(Name As String, place As Worksheet)
   'Worksheet Variables
   Dim wsSource As Worksheet
   Dim targSource As Worksheet: Set targSource = place
   'CurrentLast Row As Long
   Dim iTargetRow As Long
   'Which Cell was Found
   Dim FoundCell As Range
   Dim copyTo As Long: copyTo = targSource.Cells(Rows.count, "A").End(xlUp).Row
   
   'Assign Variables
   Set wsSource = Worksheets("Last Month's BBS SafeUnsafe by ")
   
   Set FoundCell = check(Name)
   If Not FoundCell Is Nothing Then
       copyTo = copyTo + 1
       wsSource.Cells(FoundCell.Row).EntireRow.Copy targSource.Range("A" & copyTo)
   End If
End Sub

Check function: 
Public Function check(Name As String) As Range
   Dim Rng As Range
   Dim ws As Worksheet: Set ws = Worksheets("Last Month's BBS SafeUnsafe by ")
   If Trim(Name) <> "" Then
           Set Rng = ws.Range("C:C").Find(Name)
           If Not Rng Is Nothing Then
               Set check = Rng
           End If
   End If
End Function

示例 Excel 工作表：

“表 1”

表 2

簡而言之，使用這些圖像，只有來自工作表 2 的第一個條目被復制並粘貼到每個工作表中，而不是每個應該被粘貼到各自工作表中的條目。

Answer 1

像這樣拆分您的代碼會使其更難遵循 - 僅嘗試使用一種方法：

Sub copy2Sheets()
    Const N As Long = 116 'use const for fixed values
    
    Dim wsTable As Worksheet, wsBBS As Worksheet, i As Long
    Dim wsDest As Worksheet, f As Range, tempDep As String, tempName As String
    
    Set wsTable = ThisWorkbook.Worksheets("Table")
    Set wsBBS = ThisWorkbook.Worksheets("Last Month's BBS SafeUnsafe by ")
    
    For i = 1 To N
        tempDep = Trim(wsTable.Cells(i, "B").Value)
        tempName = Trim(wsTable.Cells(i, "A").Value)
        If Len(tempName) > 0 Then
            Set wsDest = ThisWorkbook.Worksheets(tempDep)
            Set f = wsBBS.Columns("C").Find(what:=tempName, lookat:=xlWhole)
            If Not f Is Nothing Then
                 f.EntireRow.Copy wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
            End If
        End If
    Next i
End Sub