Copy Worksheet from one workbook to another. Type Mismatch 13 - vba

I'm looking to copy just one worksheet from a workbook to another and then change the name. Nothing hugely fancy.
I keep getting a type-mismatch error and I don't know why. I've used code from others which they say works but just doesn't for me.
Any ideas.
Private Sub cmdStockLog_Click()
week = ThisWorkbook.Sheets("Stock Sheet").Range("F1")
Dim wb As Workbook
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Data\FOH Stock.xlsx")
ThisWorkbook.Sheets("Stock Sheet").Copy After:=Workbooks(wb).Sheets(Worksheets.Count)
ActiveSheet.Name = "WK" & week
End Sub

Try this code:
Private Sub cmdStockLog_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim week
week = ThisWorkbook.Sheets("Stock Sheet").Range("F1")
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Data\FOH Stock.xlsx")
ThisWorkbook.Sheets("Stock Sheet").Copy After:=wb.Sheets(wb.Sheets.Count)
Set ws = wb.Sheets(wb.Sheets.Count) ' new sheet
ws.Name = "WK" & week
End Sub

Related

VBA Debug code for using a partial name match to copy and paste between active/open workbooks

I found this code in another thread here but can't get it working in my book...
What I'm trying to achieve is... The macro to be called from a wb called "SHIFT REPORT*" which looks for and switches to a wb called "PlayerTransactionReport*" to copy some data before switching back to the SHIFT REPORT and pasting it in.
The code I have is:
Sub Import_Data()
Dim wb As Workbook
Dim ShiftReport As Workbook
Dim PlayerTransactionReport As Workbook
Set ShiftReport = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 23) = "PlayerTransactionReport" Then Set PlayerTransactionReport = wb
Next
Sheets("Sheet1").Select
Columns("A:Z").Select
Selection.Copy
Set PlayerTransactionReport = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 10) = "ShiftReport" Then Set ShiftReport = wb
Next
Sheets("Data").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Currently, it's not setting the PlayerTransactionReport to the active wb but throughout the process of debugging this by myself I've had various degrees of success, but I fear that this one might have between me, Please Help!
Thanks, Stuart
You have to refer to the Parent Worksheet, whenever you are refering to Sheets() and Columns():
Sub Import_Data()
Dim wb As Workbook
Dim ShiftReport As Workbook
Dim PlayerTransactionReport As Workbook
Set ShiftReport = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 23) = "PlayerTransactionReport" Then Set PlayerTransactionReport = wb
Next
PlayerTransactionReport.Sheets("Sheet1").Select
Columns("A:Z").Select
Selection.Copy
Set PlayerTransactionReport = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 10) = "ShiftReport" Then Set ShiftReport = wb
Next
PlayerTransactionReport.Sheets("Data").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
If you do not refer to the parent worksheet, then the ActiveSheet or the sheet where the code is, is the one referred.
As a next step you can improve the following 2 points:
How to avoid using Select in Excel VBA
Check whether the PlayerTransactionReport is not Nothing, before calling it:
If Not PlayerTransactionReport Is Nothing Then
PlayerTransactionReport.Sheets("Sheet1").Select
Columns("A:Z").Select
Selection.Copy
End If
Stop using Select and Activate.
Sub Import_Data()
Dim w As long
Dim PlayerTransactionReport As Workbook, ShiftReport As Workbook
Set ShiftReport = ThisWorkbook
For w = 1 to Workbooks.count
If Left(Workbooks(w).Name, 23) = "PlayerTransactionReport" Then
Set PlayerTransactionReport = Workbooks(w)
exit for
end if
Next w
if w > Workbooks.count then
debug.print "cannot find PlayerTransactionReport"
exit sub
end if
PlayerTransactionReport.workSheets("Sheet1").Columns("A:Z").Copy _
destination:=ShiftReport.workSheets("Data").Range("A1").
End Sub

How do I ensure the VBA code saves the workbook to the file path declared?

The following is my code in an attempt to delete a number of sheets in order to save a workbook with specific worksheets only:
Sub SeperateWB2()
Dim ws As Worksheet
Dim wb As Workbook
Dim sheetname As Variant
Dim ddl As Variant
ddl = "PhaseTransferDropDowns"
sheetname = InputBox("Please specify sheet name:")
Path = "C:\My Documents\Phase Transfer\Test\"
For Each ws In ThisWorkbook.Worksheets 'SetVersions
If Not ws.Name = sheetname And Not ws.Name = ddl Then
Application.DisplayAlerts = False
ws.Delete
End If
Next ws
wb.SaveAs Path & ws.Name & ".xlsx", Excel.XlFileFormat.xlOpenXMLWorkbook
wb.Close
Set wb = Nothing
End Sub
The loop works fine but it refuses to save the workbook on the path I have specified.
I get this message: "Runtime error 91: Object variable or With block variable not set"
Can anyone help?
Look at your error message: Object variable or With block variable not set
It looks like you aren't able to save because you never instantiate your wb variable. Therefore wb = Nothing. You can't perform SaveAs on nothing. Try adding Set wb = ThisWorkbook below your declarations like so:
'other code
Dim ws As Worksheet
Dim wb As Workbook
Dim sheetname As Variant
Dim ddl As Variant
Set wb = ThisWorkbook
ddl = "PhaseTransferDropDowns"
'other code
The wb object variable is never assigned to anything other than Nothing. But anyway you can use ThisWorkook, if you mean to save and close the workbook that contains the running code:
With ThisWorkbook
.SaveAs Path & ws.Name & ".xlsx", Excel.XlFileFormat.xlOpenXMLWorkbook
.Close
End With
Thanks everyone!
It seems that I needed to set the workbook properly (Set wb = ThisWorkbook).
I also needed to change ws.name into sheetname.
This is the code that worked at the end:
Sub SeperateWB2()
Dim ws As Worksheet
Dim wb As Workbook
Dim sheetname As Variant
Dim ddl As Variant
Set wb = ThisWorkbook
ddl = "PhaseTransferDropDowns"
sheetname = InputBox("Please specify sheet name:")
Path = "C:\My Documents\Phase Transfer\Test\"
For Each ws In ThisWorkbook.Worksheets 'SetVersions
If Not ws.Name = sheetname And Not ws.Name = ddl Then
Application.DisplayAlerts = False
ws.Delete
End If
Next ws
wb.SaveAs Path & sheetname & ".xlsx", Excel.XlFileFormat.xlOpenXMLWorkbook
'wb.Close
End Sub

Error while trying to copy Worksheet

I am having the error "Copy Method of Worksheeet class failed" on this line:
.Sheets("Blank Forecast Sheet").Copy After:=.Sheets("Button Sheet")
I've looked around and couldn't find any solution. This code is ,as can be seen, supposed to add new sheets that I will rename, once, I get this problem solved.
Sub addnewsheet()
Dim wbook As Workbook
Set wbook = Application.ActiveWorkbook
Dim newsheet As Worksheet
Dim datasheet As Worksheet
Dim m As String
Dim y As Integer
m = Format(Date, "mmmm")
y = Format(Date, "yyyy")
With wbook
.Sheets("Blank Forecast Sheet").Copy After:=.Sheets("Button Sheet")
End With
End Sub
Use ThisWorkbook instead of wbook and .Worksheets instead of .Sheets:
Sub addnewsheet()
Dim newsheet As Worksheet
Dim datasheet As Worksheet
Dim m As String
Dim y As Integer
m = Format(Date, "mmmm")
y = Format(Date, "yyyy")
With ThisWorkbook
.Worksheets("Blank Forecast Sheet").Copy After:=.Worksheets("Button Sheet")
End With
End Sub

I get a Run-time Error #1004 for my VBA code with a Named range?

why does this code run fine:
Sub SelectRange()
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim sourceSheetSum As Worksheet
Set sourceBook = ActiveWorkbook
Set sourceSheet = sourceBook.Sheets("Tabelle1")
ActiveWorkbook.Names.Add _
Name:="ggg", _
RefersTo:="=Sheet1!A4:L37"
sourceSheet.Select
sourceSheet.Range("A4:L37").Select
End Sub
However if I change
sourceSheet.Range("A4:L37").Select
to:
sourceSheet.Range("ggg").Select
I receive a run-time error 1004
Try the code below, it will create "ggg" named range from cells "A4:L37" in "Tabelle1" sheet.
Afterwards, it sets another Range MyNamedRange to the named Range("ggg") - this step is not necessary, I just like to work with variables for Range.
At the end, it selects MyNamedRange.
Code
Sub SelectRange()
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim sourceSheetSum As Worksheet
Dim MyNamedRange As Range
Set sourceBook = ActiveWorkbook
Set sourceSheet = sourceBook.Sheets("Tabelle1")
' create the named range "ggg"
sourceBook.Names.Add _
Name:="ggg", _
RefersTo:="=" & sourceSheet.Name & "!A4:L37"
Set MyNamedRange = Range("ggg") ' <-- set the Range to your NamedRange "ggg"
sourceSheet.Activate '<-- activate the sheet first
MyNamedRange.Select '<-- select the Named Range
End Sub
Try this:
SourceSheet.Range(Names.Item("ggg")).Select

Save Selected Sheets to a different work book in VBA

I would like to save a number of worksheets from the current workbook to a different workbook and exclude a sheet named "buttons" (in current one) from that saving process.
Can anybody help please? The number of worksheets is changeable FYI.
Below is what I have so far which include all the sheets from current workbook.
Sub SaveAs()
D1 = VBA.Format(Now, "mm_DD_yyyy")
For Each ws In Application.Workbooks
ws.SaveAs Filename:="C:\Users\e2309\Desktop\Andy's\GBB_Report_" & D1 & ".csv"
Next ws
Application.Quit
End Sub
Or more directly
copy the entire workbook
delete the redundant sheet
code
Sub Simpler()
Dim wb As Workbook
Dim strFile As String
strFile = "C:\temp\yourfile.xlsm"
ThisWorkbook.SaveAs strFile, xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = False
ThisWorkbook.Sheets("buttons").Delete
Application.DisplayAlerts = True
End Sub
This might get you a little closer. Note this is not complete and very untested.
Sub work()
Dim WB As Workbook
Dim Nwb As Workbook
Dim WS As Worksheet
Set Nwb = New Workbook
Set WB = ThisWorkbook
For Each WS In WB.Sheets
If WS.Name <> "Don't copy" Then
WS.Copy Nwb.Sheets("sheet1")
End If
Next
Nwb.Save
End Sub