匹配工作表中的單元格並將其複製到相應的選項卡

Question

我從每個銷售訂單收到一個類似LTest的表單，我想從LTest複製某些數據並將其複製到2016 Test 1中。每個表單的格式都相同，我想使用LTest的單元格B3中的數據在2016測試1中選擇適當的選項卡，然後將該信息插入到同一工作表的相應單元格中。 LTest的名稱因訂單而異，我將不得不調整表單以包含也是唯一的訂單號。

一個問題是LTest和2016測試1是不同的電子表格。

Sub Keysha_Bee() 
Dim wb1 As Workbook 
Dim ws1 As Worksheet 
Dim wb2 As Workbook 
Dim ws2 As Worksheet 
Dim SheetID As String 
Dim i As Integer 
Dim lrow As Integer 

Set wb1 = Workbooks("LTest") 
Set ws1 = wb1.Sheets(1) 
Set wb2 = Workbooks("2016 Test1") 

If InStr(ws1.Range("B3"), "FPPI") > 0 Then SheetID = "FPPI-Routed" 
If InStr(ws1.Range("B3"), "USPPI") > 0 Then SheetID = "USPPI-Routed" 
If InStr(ws1.Range("B3"), "Standard") > 0 Then SheetID = "Standard" 

i = 1 

Do Until i > wb2.Sheets.Count 
    If wb2.Sheets(i).Name = SheetID Then Set ws2 = wb2.Sheets(i) Else GoTo Nexti 
    lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1 
    ws2.Cells(lrow, 2) = ws1.Range("D6") 'Customer Name 
    If ws2.Range("D14") = "" Then 
     ws2.Cells(lrow, 3) = ws1.Range("D17") 'Agent's Name 
     ws2.Cells(lrow, 4) = ws1.Range("D18") 'Auth Agent's Email 
    Else 
     ws2.Cells(lrow, 3) = ws1.Range("D15") 'Agent's Name 
     ws2.Cells(lrow, 4) = ws1.Range("D16") 'Auth Agent's Email 
    End If 
    ws2.Cells(lrow, 5) = "NO" 'Routed, not sure what this is supposed to reference 
    ws2.Cells(lrow, 6) = ws1.Range("D20") ' Routed 
    ws2.Cells(lrow, 7) = ws1.Range("D26") ' Origin 
    ws2.Cells(lrow, 8) = ws1.Range("D27") ' Hazardous 
    ws2.Cells(lrow, 9) = ws1.Range("D28") ' UC Type 
    ws2.Cells(lrow, 10) = "Date" 'Not sure what this is supposed to refference 

Nexti: 
i = i + 1 
Loop 


End Sub 

Answer 1

試試這個（編者）：

Sub Keysha_Bee() 
    Dim wb1 As Workbook, wb As Workbook 
    Dim ws1 As Worksheet 
    Dim wb2 As Workbook 
    Dim ws2 As Worksheet 
    Dim SheetID As String 
    Dim i As Integer 
    Dim lrow As Integer 

    Set wb2 = ThisWorkbook '<<edited 
    'get the "other open workbook" (must have only the 2 open!) 
    For Each wb In Application.WorkBooks 
     If wb.Name <> wb2.Name then 
      Set wb1 = wb 
      Exit For 
     End If 
    Next wb 
    If wb1 Is Nothing Then 
     MsgBox "No other workbook open!" 
     Exit Sub 
    End If 

    Set ws1 = wb1.Sheets(1) 

    If InStr(ws1.Range("B3"), "FPPI") > 0 Then SheetID = "FPPI-Routed" 
    If InStr(ws1.Range("B3"), "USPPI") > 0 Then SheetID = "USPPI-Routed" 
    If InStr(ws1.Range("B3"), "Standard") > 0 Then SheetID = "Standard" 

    On Error Resume Next 'ignore any error 
    Set ws2 = wb2.Worksheets(SheetID) 
    On Error GoTo 0  'stop ignoring errors 

    'was ws2 set ? 
    If ws2 Is Nothing Then 
     MsgBox "Sheet '" & SheetID & "' was not found!", vbExclamation 
     Exit Sub 
    End If 

    lrow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1 
    ws2.Cells(lrow, 2) = ws1.Range("D6") 'Customer Name 
    If ws2.Range("D14") = "" Then 
     ws2.Cells(lrow, 3) = ws1.Range("D17") 'Agent's Name 
     ws2.Cells(lrow, 4) = ws1.Range("D18") 'Auth Agent's Email 
    Else 
     ws2.Cells(lrow, 3) = ws1.Range("D15") 'Agent's Name 
     ws2.Cells(lrow, 4) = ws1.Range("D16") 'Auth Agent's Email 
    End If 
    ws2.Cells(lrow, 5) = "NO" 'Routed, not sure what this is supposed to reference 
    ws2.Cells(lrow, 6) = ws1.Range("D20") ' Routed 
    ws2.Cells(lrow, 7) = ws1.Range("D26") ' Origin 
    ws2.Cells(lrow, 8) = ws1.Range("D27") ' Hazardous 
    ws2.Cells(lrow, 9) = ws1.Range("D28") ' UC Type 
    ws2.Cells(lrow, 10) = "Date" 'Not sure what this is supposed to refference 

End Sub