VBA issue creating new workbook with range

[Darkcloud617]

Hello,

I am trying to figure out a VBA code for creating a new workbook with data paste- but I seem to keep getting errors with whatever changes I make. Essentially I am trying to have excel (VBA) take a range from the active sheet in a workbook (under a locked worksheet/workbook), create a new workbook and paste the copied range to cells A1. Seems relatively simple but I think I may be having issues because the workbook and sheet are locked and issues referencing the activesheet instead of a specific sheet name. The workbook where the range is copied from will have a name though. (I can make a reference to the password in another cell for it to unlock- but I cant seem to get excel to do this correctly)

I included a simple code below but when I am trying to reference the activesheet it gives a subscript error. Also, I am having issues addressing the locked workbooks and sheets.

Any help would be greatly appreciated.

Thank you.

Sub CopyItOver()
  Set NewBook = Workbooks.Add
  Workbooks("WorkbookName.xlsx").ActiveSheet.Range("A1:K10").Copy
  NewBook.Worksheets("Report").Range("A1").PasteSpecial (xlPasteValues)
  NewBook.SaveAs Filename:=NewBook.Worksheets("Report").Range("E3").Value
End Sub

 

[juddaaaa]

Try this

Sub CopyItOver()

    Dim SourceWorkbook As Workbook
    If IsWorkbookOpen("WorkbookName") Then
        Set SourceWorkbook = Workbooks("WorkbookName")
    Else
        Set SourceWorkbook = Workbooks.Open( _
            Filename:="C:\WorkbookName.xlsx")
    End If

    With Workbooks.Add
        With .Sheets(1)
            .Name = "Report"
            .Range("A1:K10").Value = SourceWorkbook.Sheets("WorksheetName").Range("A1:K10").Value
        End With
      
        .SaveAs _
            Filename:=Sheets("Report").Range("E3").Value
    End With

End Sub

Function IsWorkbookOpen(Bk As String) As Boolean

    Dim Book As Workbook
  
    On Error Resume Next
    Set Book = Workbooks(Bk)
    On Error GoTo 0
  
    If Not Book Is Nothing Then IsWorkbookOpen = True

End Function