Vba 匹配工作表中的单元格并将其复制到相应的选项卡

Vba 匹配工作表中的单元格并将其复制到相应的选项卡,vba,macros,Vba,Macros,我从每个销售订单收到类似LTest的表格,我想从LTest复制某些数据并将其复制到2016测试1中。每个表格的格式都相同,我想使用LTest单元格B3中的数据选择2016测试1中的适当选项卡,然后将信息插入同一工作表的相应单元格中。LTest的名称将因订单而异,我将不得不调整表单以包含一个订单号,该订单号也将是唯一的 其中一个问题是LTest和2016测试1是不同的电子表格 Sub Keysha_Bee() Dim wb1 As Workbook Dim ws1 As Worksheet Dim

我从每个销售订单收到类似LTest的表格,我想从LTest复制某些数据并将其复制到2016测试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
试试这个(编辑):

Sub-Keysha_-Bee()
将wb1作为工作簿,将wb作为工作簿
将ws1设置为工作表
将wb2设置为工作簿
将ws2设置为工作表
将单张纸变暗为字符串
作为整数的Dim i
Dim lrow作为整数

设置wb2=ThisWorkbook“代码的实际问题是什么?”?你想改变的是什么?Tim,我在设置wb1=工作簿(“LTest”)时挂断了电话-我不知道为什么会在那里被发现,因为我打开了两个工作簿。此外,我将此工作簿命名为L Test,用于此对话,但一旦工作正常,工作簿的名称将有所不同。如何解决这个问题?需要一些比“挂起”更具描述性的东西,请尝试
Set wb1=Workbooks(“LTest.xlsx”)
-或任何实际的扩展名。名称将如何变化?如果您需要能够使用随机文件,则可以使用
Application.getOpenFilename
选择一个(只要它已关闭),然后打开它。您的代码在哪里?是否在“2016测试1”中?如果是,则可以使用
此工作簿
,而不必使用名称。是的,文件名会有所不同,这是正确的。代码在2016年测试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