VBA导入数据：如果不'；不存在

我构建了这段代码，它从工作簿导入数据并粘贴到另一个工作簿。原始工作簿由数百页组成（每个国家一页，由ISO 2位代码标识：AE、AL、AM、AR等）。宏将打开这些工作表中的每个工作表，复制同一单元格，并在新工作簿中打印所有这些单元格。 问题是，例如，如果工作表F（AM）不存在，宏将停止。我想确保，如果一个工作表不存在，宏将与所有其他工作表（即F（AR）、F（AT）、F（AU））一起继续，直到结束。 有人有什么建议吗？ 非常感谢

    Sub ImportData()
    Dim Wb1 As Workbook
    Dim MainBook As Workbook
    Dim Path As String
    Dim SheetName As String

    'Specify input data
    Path = Worksheets("Input").Range("C6").Value
    'Decide in which target sheet print the results
    SheetName = "Data"
    'From which sheets you need to take the data?
    OriginSheet145 = "F(AE)"
    OriginSheet146 = "F(AL)"
    OriginSheet147 = "F(AM)"
    OriginSheet148 = "F(AR)"
    OriginSheet149 = "F(AT)"
    OriginSheet150 = "F(AU)"
    'Set the origin workbook
    Set Wb1 = Workbooks.Open(Path & "_20171231.xlsx")
    'Set the target workbook
    Set MainBook = ThisWorkbook

    'Vlookup to identify the correct data point
    Wb1.Sheets(OriginSheet145).Range("N25").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
    Wb1.Sheets(OriginSheet146).Range("N26").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
    Wb1.Sheets(OriginSheet147).Range("N27").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
    Wb1.Sheets(OriginSheet148).Range("N28").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
    Wb1.Sheets(OriginSheet149).Range("N29").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
    Wb1.Sheets(OriginSheet150).Range("N30").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
    'Copy the data point and paste in the target sheet
    Wb1.Sheets(OriginSheet145).Range("N25").Copy
    MainBook.Sheets(SheetName).Range("AW5").PasteSpecial xlPasteValues
    Wb1.Sheets(OriginSheet146).Range("N26").Copy
    MainBook.Sheets(SheetName).Range("AW6").PasteSpecial xlPasteValues
    Wb1.Sheets(OriginSheet147).Range("N27").Copy
    MainBook.Sheets(SheetName).Range("AW7").PasteSpecial xlPasteValues
    Wb1.Sheets(OriginSheet148).Range("N28").Copy
    MainBook.Sheets(SheetName).Range("AW8").PasteSpecial xlPasteValues
    Wb1.Sheets(OriginSheet149).Range("N29").Copy
    MainBook.Sheets(SheetName).Range("AW9").PasteSpecial xlPasteValues
    Wb1.Sheets(OriginSheet150).Range("N30").Copy

    MainBook.Save
    Wb1.Close savechanges:=False

    MsgBox "Data: imported!"

    End Sub

---

此函数返回

TRUE

或

FALSE

，指示工作簿对象中是否存在以字符串

wsName

命名的工作表

如果工作表不存在，请使用

IF

语句跳过适用的代码

---

编辑： 我可以告诉你，你在你的代码中投入了大量的工作，这太棒了，所以当我说它给了我焦虑时，不要误会，所以我不得不简化它。。。有很多不必要的步骤

我相信“正确的方式”就是“任何方式都有效”，所以工藤已经走到了这一步。编程有一个陡峭的学习曲线，所以我想我应该提供一个替代代码块来代替你的。（Explicit选项位于模块的最顶端，它将“强制”您正确声明/处理变量、对象等。）

在没有看到您的数据的情况下，如果您选择使用此功能，我无法保证它会起作用-事实上，您必须尝试找出某个单元格引用错误的地方

Option Explicit

Sub ImportData()

    Const SheetName = "Data" 'destination sheet name
    Const sourceFile = "_20171231.xlsx" 'source filename for some reason
    Dim wbSrc As Workbook, wbDest As Workbook, sht As Variant
    Dim stPath As String, arrSourceSht() As Variant, inRow As Long

    Set wbDest = ThisWorkbook 'dest wb object
    stPath = Worksheets("Input").Range("C6").Value 'source wb stPath
    'create array of source sheet names "146-150":
    arrSourceSht = Array("F(AE)", "F(AL)", "F(AM)", "F(AR)", "F(AT)", "F(AU)")
    Set wbSrc = Workbooks.Open(stPath & sourceFile) 'open source wb

    With wbSrc
        'VLookup to identify the correct data point
        inRow = 5 'current input row
        For Each sht In arrSourceSht
            If wsExists(wbSrc, CStr(sht)) Then
                wbDest.Sheets(sht).Range("AW" & inRow) = Application._
                  WorksheetFunction.VLookup("010", Range(.Sheets(sht).Range("N" & _
                  20 + inRow).Offset(-10), .Sheets(sht).Range("N" & 20 + inRow).Offset(-7)), 2, False)
            End If
            inRow = inRow + 1 'new input row
        Next sht

        wbDest.Save 'save dest
        .Close savechanges:=False 'don't save source

    End With
    MsgBox "Data: imported!"

End Sub

Function wsExists(wb As Workbook, wsName As String) As Boolean
    Dim ws: For Each ws In wb.Sheets
    wsExists = (wsName = ws.Name): If wsExists Then Exit For
    Next ws
End Function

---

如果您有任何问题，请告诉我，如果您愿意，我可以带您了解它的工作原理。（我每天至少在这里呆一次。）

我不确定你到底在这里干什么，但我相信有更好的方法。什么是

OriginSheet145

到

OriginSheet150

以及它们在哪里设置？它们会改变吗？您正在将硬编码公式（

=VLOOKUP（“010”，C[-10]：C[-7]，2，FALSE）

）复制到6个单元格，然后将这些单元格复制到其他地方？？？

原始表

是宏获取数据的原始表。这些板材的名称会发生变化（F（AE）、F（AL）、F（AM）…），但所有板材的内部结构始终相同。因此，对于这些工作表中的每个工作表，代码都会获取一个数据点（通过VLOOKUP标识），从

原始工作表

复制数据点并粘贴到目标工作簿中。

Option Explicit

Sub ImportData()

    Const SheetName = "Data" 'destination sheet name
    Const sourceFile = "_20171231.xlsx" 'source filename for some reason
    Dim wbSrc As Workbook, wbDest As Workbook, sht As Variant
    Dim stPath As String, arrSourceSht() As Variant, inRow As Long

    Set wbDest = ThisWorkbook 'dest wb object
    stPath = Worksheets("Input").Range("C6").Value 'source wb stPath
    'create array of source sheet names "146-150":
    arrSourceSht = Array("F(AE)", "F(AL)", "F(AM)", "F(AR)", "F(AT)", "F(AU)")
    Set wbSrc = Workbooks.Open(stPath & sourceFile) 'open source wb

    With wbSrc
        'VLookup to identify the correct data point
        inRow = 5 'current input row
        For Each sht In arrSourceSht
            If wsExists(wbSrc, CStr(sht)) Then
                wbDest.Sheets(sht).Range("AW" & inRow) = Application._
                  WorksheetFunction.VLookup("010", Range(.Sheets(sht).Range("N" & _
                  20 + inRow).Offset(-10), .Sheets(sht).Range("N" & 20 + inRow).Offset(-7)), 2, False)
            End If
            inRow = inRow + 1 'new input row
        Next sht

        wbDest.Save 'save dest
        .Close savechanges:=False 'don't save source

    End With
    MsgBox "Data: imported!"

End Sub

Function wsExists(wb As Workbook, wsName As String) As Boolean
    Dim ws: For Each ws In wb.Sheets
    wsExists = (wsName = ws.Name): If wsExists Then Exit For
    Next ws
End Function