Сопоставьте и скопируйте ячейку на листе на соответствующую вкладку

Question

Я получаю такую ​​форму, как LTest, из каждого заказа клиента, я хотел бы скопировать определенные данные из LTest и скопировать их в 2016 Тест 1. Каждая форма отформатирована одинаково, и я хочу используйте данные в ячейке B3 из LTest, чтобы выбрать соответствующую вкладку в тесте 2016 Тест 1, а затем вставьте информацию в соответствующие ячейки того же листа. Название LTest будет отличаться от одного порядка к другому, и мне придется настроить форму, чтобы включить номер заказа, который также будет уникальным.

Одной из проблем является LTest и 2016 Test 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