Question

我正在尝试将一行信息添加到我的某个工作表中，以自动将该行添加到同一工作簿中的其他工作表。

我找到了这段代码并稍微调整了一下：

Sub addrow()

Public Sub worksheet_change(ByVal target As Range)

    Set sourcebook = ThisWorkbook
    Set sourcesheet = sourcebook.Worksheets("sheet1")

    Set targetbook = ThisWorkbook
    Set targetsheet = targetbook.Worksheets("sheet10")

    If sourcesheet.Cells(198, 16).Value = "Auto" Or _
        sourcesheet.Cells(198, 16).Value = "Connect" Or _
        sourcesheet.Cells(198, 16).Value = "Multiple*" Or _
        sourcesheet.Cells(198, 16).Value = "Property" Or _
        sourcesheet.Cells(198, 16).Value = "Umbrella" Or _
        sourcesheet.Cells(198, 16).Value = "WC" Then
        GoTo link
    Else
        GoTo insertion
    End If

    insertion: targetsheet.Activate
    ActiveSheet.Rows(198).EntireRow.Insert

    sourcesheet.Activate

link:
    'targetsheet.Cells(194, targetsheet.Range("initial response").Column) = sourcesheet.Cells(198, 16).Value
    targetsheet.Cells(194, 16) = sourcesheet.Cells(198, 16).Value

    targetsheet.Cells(194, 16) = sourcesheet.Cells(198, 16).Value

End Sub

我收到错误消息“Compile Error：Expected End Sub”，它突出显示第一行代码 - Sub addrow（）。当我尝试使用这一行时，VBA要求我在尝试运行它时创建一个新宏，然后将该行添加回来，然后我回到原点。

Answer 1

专注于前3行。那里有两个Sub声明。只保留一个。也许删除行

Public Sub worksheet_change(ByVal target As Range)

我认为你应该删除这一行而不是另一行，因为它似乎被遗忘了以前的一些工作。其参数target未在代码中使用，您的代码最适合使用名称addrow而不是worksheet_change。

这是您重构的代码：

变量名保持VBA命名约定
重新排列的代码块，因此可以排除gotos和标签

Sub AddRow()

    Set SourceBook = ThisWorkbook
    Set SourceSheet = SourceBook.Worksheets("sheet1")

    Set TargetBook = ThisWorkbook
    Set TargetSheet = TargetBook.Worksheets("sheet10")

    If Not (SourceSheet.Cells(198, 16).Value = "Auto"
            Or SourceSheet.Cells(198, 16).Value = "Connect"
            Or SourceSheet.Cells(198, 16).Value = "Multiple*"
            Or SourceSheet.Cells(198, 16).Value = "Property"
            Or SourceSheet.Cells(198, 16).Value = "Umbrella"
            Or SourceSheet.Cells(198, 16).Value = "WC") Then
        TargetSheet.Activate
        ActiveSheet.Rows(198).EntireRow.Insert
        SourceSheet.Activate
    End If

    'TargetSheet.Cells(194, TargetSheet.Range("initial response").Column) = SourceSheet.Cells(198, 16).Value
    TargetSheet.Cells(194, 16) = SourceSheet.Cells(198, 16).Value
    TargetSheet.Cells(194, 16) = SourceSheet.Cells(198, 16).Value

End Sub

Answer 2

Private Sub CMDSAVE_CLICK()
Dim WORDAPP As word.Application
Dim worddoc As word.document
Dim filename
filename = Range("c2").Value
Sheets("ÝÇ˜ÊæÑ").Range("a1:k26").Select
Selection.Copy
Set WORDAPP = CreateObject("word.application")
Set worddec = WORDAPP.documents.Add
WORDAPP.Selection.pasteexeeltabele False, False, False
filename = "f:\" & filename
wordpec.Close
WORDAPP.Quit
Set wordpic = Nothing
Set WORDAPP = Nothing
Application.CutCopyMode = False
End Sub

如何修复编译错误：预期End Sub？

2 个答案: