Vba 循环遍历A列,并在不同工作簿上复制匹配工作表中的值

Vba 循环遍历A列,并在不同工作簿上复制匹配工作表中的值,vba,excel,Vba,Excel,我有两个工作簿,其中工作簿1在a列中有一个名称列表,每个名称都有一行值。 工作簿2也有标有名称的工作表。其中一些名称与工作簿1 A列中的名称列表相同 我试图实现的是检查A列中的名称是否与工作表名称匹配。如果是,我想复制该行中的值,并将它们粘贴到工作簿2工作表中的特定单元格中。 如果A列中的每个名称在工作簿2中的相应工作表的顺序相同,则我下面的代码可以正常工作。但是,我希望它能够跳过空白或跳过工作簿2中没有工作表的名称。因此,我添加了一个if语句,看看这是否解决了问题,但这不起作用。我得到一个错误

我有两个工作簿,其中工作簿1在a列中有一个名称列表,每个名称都有一行值。 工作簿2也有标有名称的工作表。其中一些名称与工作簿1 A列中的名称列表相同

我试图实现的是检查A列中的名称是否与工作表名称匹配。如果是,我想复制该行中的值,并将它们粘贴到工作簿2工作表中的特定单元格中。 如果A列中的每个名称在工作簿2中的相应工作表的顺序相同,则我下面的代码可以正常工作。但是,我希望它能够跳过空白或跳过工作簿2中没有工作表的名称。因此,我添加了一个if语句,看看这是否解决了问题,但这不起作用。我得到一个错误:“应用程序定义的或对象定义的错误”,突出显示if语句

原始工作代码没有IF语句。只要A列中没有空格,并且每个名字都有相同顺序的匹配表,它就可以工作

我还尝试在下一行添加错误恢复,但这只是停止触发错误代码。它会将第一行复制/粘贴到正确的单元格中,但其余的则不会复制/粘贴

Sub Measures()

Dim wb1 As Workbook
Dim Sht As Worksheet
Dim Rng, Rng2 As Range
Dim wb2 As Workbook
Dim cell As Range
Dim ws As Worksheet

Set wb1 = ThisWorkbook
Set wb2 = Workbooks("November Stream 1 v2.xlsm")
Set Sht = wb1.Worksheets("Summary")
Set Rng = Sht.Range("A7:A" & Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row)

For Each cell In Rng
Set ws = wb2.Sheets(cell.Text)

If wb1.Sheets("Summary").Range("A" & i) = wb2.Sheet.Name Then

   Select Case ws.Range("A4").Value
        Case "green"  '
        ws.Range("B29").Value = cell.Offset(0, 1).Value
        ws.Range("B33").Value = cell.Offset(0, 2).Value
        ws.Range("B37").Value = cell.Offset(0, 3).Value
        ws.Range("B40").Value = cell.Offset(0, 4).Value
        ws.Range("B44").Value = cell.Offset(0, 5).Value
        
        Case "red"
        ws.Range("B47").Value = cell.Offset(0, 6).Value
        ws.Range("B51").Value = cell.Offset(0, 7).Value
        ws.Range("B54").Value = cell.Offset(0, 8).Value
        ws.Range("B60").Value = cell.Offset(0, 9).Value
        ws.Range("B65").Value = cell.Offset(0, 11).Value
        
        Case "blue"
        ws.Range("B68").Value = cell.Offset(0, 12).Value
        ws.Range("B74").Value = cell.Offset(0, 14).Value
        ws.Range("B76").Value = cell.Offset(0, 15).Value
      End Select
        End If
        
    Next cell

End Sub

我认为您要测试的是工作表是否存在,而不是工作表是否与您设置的名称匹配。看看下面的内容,我已经整理了一下,并使用错误处理来“测试”您设置名称的工作表是否存在

Sub Measures()
    Dim wb2 As Workbook
    Dim ws As Worksheet
    Dim Rng, Rng2 As Range
    Dim cell

    Set wb2 = Workbooks("November Stream 1 v2.xlsm")
    With ThisWorkbook.Worksheets("Summary")
        Set Rng = .Range("A7:A" & .cells(.Rows.Count, "A").End(xlUp).Row)
    End With

    For Each cell In Rng
        On Error Resume Next
        Set ws = Nothing
        Set ws = wb2.Sheets(cell.Value2)
        On Error GoTo 0

        If Not ws Is Nothing Then
            Select Case ws.Range("A4").Value2
                Case "green"
                    ws.Range("B29").Value = cell.Offset(0, 1).Value
                    ws.Range("B33").Value = cell.Offset(0, 2).Value
                    ws.Range("B37").Value = cell.Offset(0, 3).Value
                    ws.Range("B40").Value = cell.Offset(0, 4).Value
                    ws.Range("B44").Value = cell.Offset(0, 5).Value

                Case "red"
                    ws.Range("B47").Value = cell.Offset(0, 6).Value
                    ws.Range("B51").Value = cell.Offset(0, 7).Value
                    ws.Range("B54").Value = cell.Offset(0, 8).Value
                    ws.Range("B60").Value = cell.Offset(0, 9).Value
                    ws.Range("B65").Value = cell.Offset(0, 11).Value

                Case "blue"
                    ws.Range("B68").Value = cell.Offset(0, 12).Value
                    ws.Range("B74").Value = cell.Offset(0, 14).Value
                    ws.Range("B76").Value = cell.Offset(0, 15).Value
            End Select
        End If
    Next cell
End Sub

尝试循环遍历wb2中的每个工作表,并将它们的名称与wb1中的当前单元格进行比较

作为psuedo(这是一个粗略的想法,我现在没有时间完整地输入,对不起)


wb2.sheet.name
语法无效。您需要参考您的目标工作表,即
wb2.sheets(“SheetName”)。name
我明白了。我试图做的是让它检查工作表名称是否与工作簿1的名称列表中的名称相同。如果是,则转至“案例”,如果不是,则检查列表上的下一个名称,并查看是否有同名的工作表。所以我没有一个具体的工作表名称。希望这是有意义的,谢谢。我想我知道你想做什么了,但这将是因为你在之前的行中将它设置为值a。没有错误代码,并且它没有复制任何内容。对不起,只是注意到错误的值设置了工作表名。现在就试试谢谢,这很有效,但现在还有另一个问题。它不是将值复制到与名称相同的行上,而是从其正下方的行中复制所有名称的值。我不知道这是否是因为正下方的行值在A列中没有名称。例如:单元格A7的名称为“Jack”,我想复制第7行(单元格B7以后)中的值,单元格A8为空,但有单元格B8以后的值,这些是要复制的值。删除具有空白名称的行可以解决这个问题,但我在A列中有100个空白单元格,其相邻行中有值。啊-当您有空白单元格时,工作表将保持设置为空白单元格的前一行。我已经更新了上面的设置,在重新设置之前将工作表重置为空。这应该可以处理列中的空白单元格,现在这充满了错误。此外,您不需要
Activate
语句,它只是一个不必要的窃听,也不需要两个循环来实现这一点。如果用户能够在工作簿运行时与工作簿进行交互,那么这个问题也会解决。因此,为什么我提到这只是一个粗略的想法?如果有更多的项目,我会测试一些东西并使其工作。我更强调基本的语法错误。对于wb1.range(“您的范围”)中的每个单元格,您的循环应声明为
中的
和结束
。此外,您不需要wb2.Activate
——它什么都不做。您应该使用
工作表
而不是
ActiveSheet
,因为您的循环当前没有通过工作表。相反,它只是测试
ActiveSheet
名称是否等于
单元格的值,即
wb2
for each cell. wb1.range("your range)
    wb2.activate
    for each worksheet in wb2
        if activesheet.name = cell.value then
            'do stuff
        else
            'do nothing
        end if
    next worksheet
next cell