1
votes

I am trying, when a line of information is added to one of my sheets, to automatically add that line to a different sheet in the same workbook.

I found this code and tweaked it a little:

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

I get the error message "Compile Error: Expected End Sub" and it highlights that first line of code- Sub addrow(). When I try taking this line out, VBA requires me to create a new macro when I try and run it, which then adds that line back in, and I am back to square one.

2
You have Sub addrow() and then immediately Public Sub worksheet_change(ByVal target As Range) -- subroutines cannot overlap, and every Sub should have a matching End Sub, hence this error. Either remove Sub addrow() and make sure that workshett_change() is actually usable, or if you are manually running the macro then remove the worksheet_change() line, but keep Sub addrow(). Hope that helps. P.S.: please no ALL CAPS in messages. - Levon

2 Answers

4
votes

Focus on first 3 lines. You have two Sub declarations there. Keep only one. Perhaps remove line

Public Sub worksheet_change(ByVal target As Range)

I think you should remove this line and not the other one because it seems to be forgotten from some previous work. Its parameter target is not used in the code and what your code does better fits with name addrow than with worksheet_change.

This is your code refactored:

  • variable names keep VBA naming convention
  • blocks of code rearranged so gotos and labels could be excluded

.

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
-1
votes
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