如何使我的VBA代码什么都不做，并移动到下一步/ VBA运行时错误91
我有我的代码的结果的问题：主要想法是，我有一个Word模板，我复制从Excel文件粘贴不同的表。 这些表格有12张不同的表格，分别命名为表格1，表格2等。当这些表格中有一些数据时，代码完美地工作。 这是整个代码：
Sub CreateBasicWordReport() 'Create word doc automatically Dim wApp As Word.Application Dim SaveName As String Set wApp = New Word.Application With wApp 'Make word visible .Visible = True .Activate .Documents.Add "C:\Users\MyDesktop\TemplateWordFile.dotx" 'paste supplier name in word Sheets("Sheet1").Range("C1").Copy .Selection.Goto what:=wdGoToBookmark, name:="SupplierName" .Selection.PasteSpecial DataType:=wdPasteText 'Dynamic range Dim Table1 As Worksheet Dim Table2 As Worksheet Dim LastRow As Long Dim LastColumn As Long Dim StartCell As Range Set Table1 = Worksheets("Table 1") Set Table2 = Worksheets("Table 2") Set StartCell = Range("A1") 'Paste table 1 in word Worksheets("Table 1").UsedRange LastRow = Table1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Table1.Range("A1:J" & LastRow).Copy .Selection.GoTo what:=wdGoToBookmark, name:="Table1" .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _ Placement:=wdAlignRowLeft, DisplayAsIcon:=True 'Paste table 2 in word Worksheets("Table 2").UsedRange LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Worksheets("Table 2").Range("A1:J" & LastRow).Copy .Selection.GoTo what:=wdGoToBookmark, name:="Table2" .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _ Placement:=wdAlignRowLeft, DisplayAsIcon:=True 'Save doc to a specific location and with a specific title Dim name As String name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _ Sheets("Sheet1").Range("C1").Value & "_" & Sheets("Sheet1").Range("H1").Value & _ "_" & Format(Now, "yyyy-mm-dd") & ".docx" .ActiveDocument.SaveAs2 Filename:=name End With End Sub 问题是纸张是空白的。 我可能只需要一个表（从表1）和IF下一个表（表2）是空的，那么我想让VBA什么都不做，并转移到下一步。 但是，然后我得到运行时错误91在我的代码这一行：
LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
我已经尝试了“on error resume next”命令，如下所示：
'Paste table 2 in word Worksheets("Table 2").UsedRange On Error Resume Next LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Worksheets("Table 2").Range("A1:J" & LastRow).Copy .Selection.GoTo what:=wdGoToBookmark, name:="Table2" .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _ Placement:=wdAlignRowLeft, DisplayAsIcon:=True
但是在这种情况下，它确实会给我的word文件带来一个空的表格（五行，10行没有任何内容，只是表格的轮廓），而我只是希望它是空白的/我的word文件中没有任何内容出现。
有没有人知道如何可以解决这个问题呢？
你可能只需要添加If Not IsEmpty(Table1.UsedRange) Then语句到你的代码中。 如果工作表完全为空，这将阻止代码运行。 如果您需要更多帮助，请发表评论。
Sub CreateBasicWordReport() 'Create word doc automatically Dim wApp As Word.Application Dim SaveName As String Set wApp = New Word.Application With wApp 'Make word visible .Visible = True .Activate .Documents.Add "C:\Users\MyDesktop\TemplateWordFile.dotx" 'paste supplier name in word Sheets("Sheet1").Range("C1").Copy .Selection.Goto what:=wdGoToBookmark, name:="SupplierName" .Selection.PasteSpecial DataType:=wdPasteText 'Dynamic range Dim Table1 As Worksheet Dim Table2 As Worksheet Dim LastRow As Long Dim LastColumn As Long Dim StartCell As Range Set Table1 = Worksheets("Table 1") Set Table2 = Worksheets("Table 2") Set StartCell = Range("A1") 'Paste table 1 in word If Not IsEmpty(Table1.UsedRange) Then LastRow = Table1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Table1.Range("A1:J" & LastRow).Copy .Selection.GoTo what:=wdGoToBookmark, name:="Table1" .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _ Placement:=wdAlignRowLeft, DisplayAsIcon:=True End If 'Paste table 2 in word If Not IsEmpty(Table2.UsedRange) Then LastRow = Worksheets("Table 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Table2.Range("A1:J" & LastRow).Copy .Selection.GoTo what:=wdGoToBookmark, name:="Table2" .Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _ Placement:=wdAlignRowLeft, DisplayAsIcon:=True End If 'Save doc to a specific location and with a specific title Dim name As String name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _ Sheets("Sheet1").Range("C1").Value & "_" & Sheets("Sheet1").Range("H1").Value & _ "_" & Format(Now, "yyyy-mm-dd") & ".docx" .ActiveDocument.SaveAs2 Filename:=name End With End Sub
不幸的是，我不能评论费边的答案，但他的build议可能会解决你的问题。 我只是觉得你应该知道你的代码在“On Error Resume Next”上做了什么，不pipe有没有错误，都会转到下一行 。 因此，为了告诉程序在发生错误时做一些不同的事情，你必须validation错误是否发生并处理。
你可以避免一些代码重复，并通过委托表cpying /粘贴到一个特定的sub来扩大你的代码应用：
Sub PasteTables(docContent As Word.Range, numTables As Long) Dim iTable As Long Dim myRng As Range With docContent For iTable = 1 To numTables Set myRng = Worksheets("Table " & iTable).UsedRange If Not IsEmpty(myRng) Then myRng.Copy .Goto(what:=wdGoToBookmark, name:="Table" & iTable).PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _ Placement:=wdAlignRowLeft, DisplayAsIcon:=True Application.CutCopyMode = False End If Next iTable End With End Sub
相应的你的主代码会缩短到：
Option Explicit Sub CreateBasicWordReport() 'Create word doc automatically Dim wApp As Word.Application Dim name As String Set wApp = New Word.Application sheets("Sheet01").Range("C1").Copy With wApp.Documents.Add("C:\Users\MyDesktop\TemplateWordFile.dotx") '<-- open word document and reference it 'Make word visible .Parent.Visible = True .Parent.Activate 'paste supplier name in word .content.Goto(what:=wdGoToBookmark, name:="SupplierName").PasteSpecial DataType:=wdPasteText Application.CutCopyMode = False '<-- it's always a good habit to set it after pasting has taken place 'paste tables PasteTables .content, 2 '<-- call your specific Sub passing the referenced document content and "2" as the maximum number of tables to loop through 'Save doc to a specific location and with a specific title name = "C:\Users\MyDesktop\Supplier\" & "DocName" & "_" & _ sheets("Sheet1").Range("C1").Value & "_" & sheets("Sheet1").Range("H1").Value & _ "_" & Format(Now, "yyyy-mm-dd") & ".docx" .ActiveDocument.SaveAs2 Filename:=name End With End Sub