paste special problems

[ajm]

i have had to change a macro recently to use an existing blank workbook instead of merely adding a new workbook. i am having problems with the new code though. the old one copied a range of cells in the MainWb and then added a NewWb, and pasted as values the selected contents from the old wb. did a few other things and that was that.

now, i have identified the blank workbook that i want to use and opened it. but cannot get the data to paste into it. the macro errors, saying "Object Required", out on the following line:

With NewWb.Sheets("Sheet1").Range("A1")

i thought i had identified the object. here is my code:

Sub ReportingWIP()
    Dim NewWb As Variant
    Dim MainWb As Workbook
    Dim MainPg As Worksheet
    Dim NewPg As Variant
    Dim MyRow As Integer
    Dim OldShcount
    Dim MyDate As Date

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With

    ActiveWorkbook.Save

    Set MainPg = ThisWorkbook.Worksheets("Consolidated Project Table")
    Set MainWb = ThisWorkbook
    NewPg = "Project Brief"

    MainPg.Unprotect "wipmaster"
    If MainPg.FilterMode Then
        MainPg.ShowAllData
    End If

    Range("a7").AutoFilter Field:=7, Criteria1:="1"
    
    MainWb.Activate
    With MainPg
    .Calculate
        .Range("C1:END3,e1:END9,q1:END22,Z1:END26,AD1:END30").SpecialCells(xlCellTypeVisible).Copy
    End With
    

    NewWb = ThisWorkbook.Path & "\WEEKLY UPDATE REPORTS\Reporting WIP blank.xls"

    Application.Workbooks.Open NewWb
    
   

 With NewWb.Sheets("Sheet1").Range("A1")  '/// this is where the problem occurs
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteFormats
        .PasteSpecial xlPasteValues
   

 
        .PageSetup.CenterHeader = "GROUP PROCUREMENT: PRIORITY 1 PROJECT UPDATE"
        .PageSetup.LeftFooter = "&D"
        .PageSetup.CenterFooter = "&F"
        .PageSetup.RightFooter = "&P of &N"
        .PageSetup.LeftMargin = Application.InchesToPoints(0.5)
        .PageSetup.RightMargin = Application.InchesToPoints(0.5)
        .PageSetup.TopMargin = Application.InchesToPoints(0.3)
        .PageSetup.BottomMargin = Application.InchesToPoints(0.3)
        .PageSetup.HeaderMargin = Application.InchesToPoints(0.1)
        .PageSetup.FooterMargin = Application.InchesToPoints(0.1)
        .PageSetup.PrintHeadings = False
        .PageSetup.PrintTitleRows = .Rows(5).Address
        .PageSetup.PrintGridlines = False
        .PageSetup.PrintComments = xlPrintNoComments
        .PageSetup.CenterHorizontally = True
        .PageSetup.CenterVertically = False
        .PageSetup.Orientation = xlLandscape
        .PageSetup.Order = xlDownThenOver
        .PageSetup.Zoom = False
        .PageSetup.FitToPagesWide = 1
        .PageSetup.FitToPagesTall = 10
        .Name = NewPg
        .Range("m3").Value = "Priority 1 Gap"
        .Range("m3").VerticalAlignment = xlVAlignCenter
    End With

    With NewWb.Sheets("Project Brief")
        Columns("A:B").Select
        Selection.Cut
        Columns("G:G").Select
        Selection.Insert Shift:=xlToRight
    End With

    '///To toggle gridlines and headings
    With ActiveWindow
        .DisplayGridlines = Not .DisplayGridlines
        Range("g6").Select
        .FreezePanes = True
        .Zoom = 75
        Rows("5:5").RowHeight = 75
        ActiveSheet.UsedRange.Locked = True
        ActiveSheet.Protect
    End With


    '///get the date for the Thursday of this week

    Select Case Format(Date, "ddd")
    Case Is = "Mon"
        MyDate = Date + 3
    Case Is = "Tue"
        MyDate = Date + 2
    Case Is = "Wed"
        MyDate = Date + 1
    Case Is = "Thu"
        MyDate = Date
    Case Is = "Fri"
        MyDate = Date - 1
    Case Is = "Sat"
        MyDate = Date - 2
    Case Is = "Sun"
        MyDate = Date - 3
    End Select

    NewWb.SaveAs (ThisWorkbook.Path & "\WEEKLY UPDATE REPORTS\Reporting WIP " & Format(MyDate, "ddmmyyyy"))

    Set NewWb = Nothing

    With ThisWorkbook.Sheets("Consolidated Project Table")

        .Protect "wipmaster", DrawingObjects:=True, _
                 contents:=True, Scenarios:=True, _
                 UserInterfaceOnly:=True
        .EnableAutoFilter = True


    End With

End Sub

in the original piece, this was used to add the new workbook:

With MainPg
        .Calculate
        .Range("C1:END3,e1:END9,q1:END22,aa1:END26,Ae1:END30").SpecialCells(xlCellTypeVisible).Copy
    End With
    Set NewWb = Workbooks.Add

    With NewWb.Sheets("Sheet1").Range("A1")
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteFormats
        .PasteSpecial xlPasteValues
    End With

    With NewWb.Sheets("Sheet1")
        .PageSetup.CenterHeader = "GROUP PROCUREMENT: PRIORITY 1 PROJECT UPDATE"
        .PageSetup.LeftFooter = "&D"
        .PageSetup.CenterFooter = "&F"
        .PageSetup.RightFooter = "&P of &N"

can anyone help out?

 

[mvptomlinson]

Before the line:

With NewWb.Sheets("Sheet1").Range("A1")

try adding:

NewWb.Sheets("Sheet1").Activate

 

[ajm]

now it errors out on the new line you suggested stating "Object Required".

 

[ajm]

have resolved it by taking out Merged Cells and using the original code. Originally wanted them in as they help make sense of the report. Thanks for trying to help me.

 

[xenou]

Under Cells | Format there is an option for center across selection which is sometimes a good substitute for merge across. I don't think we have a vertical equivalent though - but changing row height and centering can work in some cases. AB