Help with compiler error

[Pank Mehta]

I have the following code which is unfortunately giving me a "Compile Error :
Expected End With" and the only End With in the code is highlighted in yellow
when I select debug.

I am not a programmer by any strech of the imagination and any help would be
appreciated.

Sub EOM()
Dim Wks As Worksheet
Dim DestCell As Range
Dim newWks As Worksheet
Dim HeadersAreDone As Boolean
Dim mySelectedSheets As Object
Dim myRngToCopy As Range
Set mySelectedSheets = ActiveWindow.SelectedSheets
If mySelectedSheets.Count <> 3 Then
MsgBox "Please Group exactly 3 sheets before you run this macro!"
Exit Sub
End If
Set newWks = Workbooks.Add(1).Worksheets(1)
HeadersAreDone = False
For Each Wks In mySelectedSheets
ActiveWorkbook.Unprotect
With Wks
If HeadersAreDone = True Then
'do nothing
Else
.Rows(1).Copy _
Destination:=newWks.Range("a1")
HeadersAreDone = True
Set DestCell = newWks.Range("a2")
End If
With Worksheets("sheet1")
.Unprotect password:=""
Set myRngToCopy = .Range("a2",
..Cells.SpecialCells(xlCellTypeLastCell))
DestCell.Resize(myRngToCopy.Rows.Count,
myRngToCopy.Columns.Count).Value _
= myRngToCopy.Value
.Protect password:=""
End With
With newWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
'Next Wks
'delete columns you don't want.
End With
End Sub

[Bob Phillips]

You have an End With missing. Your logic is

With Wks
...
With Worksheets("sheet1")
...
End With

With newWks
...
End With

as you can see 3 Withs, 2 End With's.

You also have an unterminated For Each Wks. There is an Next WKs, but it is
commented out.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Pank Mehta" <Pank@discussions.microsoft.com> wrote in message
news:3A58F3D3-8789-4B52-AEE7-36A67675570A@microsoft.com...
> I have the following code which is unfortunately giving me a "Compile
Error :
> Expected End With" and the only End With in the code is highlighted in
yellow
> when I select debug.
>
> I am not a programmer by any strech of the imagination and any help would
be
> appreciated.
>
> Sub EOM()
> Dim Wks As Worksheet
> Dim DestCell As Range
> Dim newWks As Worksheet
> Dim HeadersAreDone As Boolean
> Dim mySelectedSheets As Object
> Dim myRngToCopy As Range
> Set mySelectedSheets = ActiveWindow.SelectedSheets
> If mySelectedSheets.Count <> 3 Then
> MsgBox "Please Group exactly 3 sheets before you run this macro!"
> Exit Sub
> End If
> Set newWks = Workbooks.Add(1).Worksheets(1)
> HeadersAreDone = False
> For Each Wks In mySelectedSheets
> ActiveWorkbook.Unprotect
> With Wks
> If HeadersAreDone = True Then
> 'do nothing
> Else
> .Rows(1).Copy _
> Destination:=newWks.Range("a1")
> HeadersAreDone = True
> Set DestCell = newWks.Range("a2")
> End If
> With Worksheets("sheet1")
> .Unprotect password:=""
> Set myRngToCopy = .Range("a2",
> .Cells.SpecialCells(xlCellTypeLastCell))
> DestCell.Resize(myRngToCopy.Rows.Count,
> myRngToCopy.Columns.Count).Value _
> = myRngToCopy.Value
> .Protect password:=""
> End With
> With newWks
> Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
> 'Next Wks
> 'delete columns you don't want.
> End With
> End Sub
>
>