從另一個板至板1複製整行，如果在比賽

Question

https://www.dropbox.com/s/f83y17dedajbsz8/example.xls

那是什麼，我想這在工作中快速出樣工作簿中鍵入唯一代碼。

眼下，表1（主）需求將所有其他工作表中的數據手動複製到其中。目前，我正在做的是我有一個我需要的唯一代碼列表，然後我轉到表單並按Ctrl + F代碼，然後將該行手動複製並粘貼到表單1（main）中。這可能有點耗時。

我想要做的只是將任意唯一代碼鍵入到工作表1中D列的任何單元格中，然後如果該代碼與任何其他工作表上的代碼相匹配，則整行將複製到工作表1.

這是否容易實現？

Answer 1

下面的VBA應該這樣做，你需要將它複製到Sheet1 (Main)的工作簿代碼部分。

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim Sheet As Worksheet 
Dim Index As Integer 
Dim Count As Integer 
Dim Match As Range 

    If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then 
     ' You've done something that has edited lots of cells. Cant handle this. 
     Exit Sub 
    End If 

    Set Sheet = ThisWorkbook.Worksheets("Main") 

    If Not Intersect(Sheet.Range("D:D"), Target) Is Nothing Then 
     ' The edited cell falls in the range D:D 
     Count = ThisWorkbook.Worksheets.Count 

     For Index = 1 To Count 
      If Not ThisWorkbook.Worksheets(Index).Name = Sheet.Name Then 
       Set Match = ThisWorkbook.Worksheets(Index).Range("D:D").Find(What:=Target.Value, LookIn:=xlValues) 
       If Not Match Is Nothing Then 
        'copy the line across 
        ThisWorkbook.Worksheets(Index).Range("A" & Match.Row & ":E" & Match.Row).Copy Sheet.Range("A" & Target.Row) 
        Exit For 
       End If 
      End If 
     Next Index 

    End If 

    If Match Is Nothing Then 
    ' optional, if the target string is not found clear the line. 
     Sheet.Range("A" & Target.Row & ":E" & Target.Row).ClearContents 
    End If 

End Sub