I'm trying to delete a worksheet from MS Access.
There's a lot of data on the sheet, including two charts. Instead of trying to delete all the data, I want to delete the sheet and re-add it.
I've looked up several ways to delete a sheet with MS Access and found the following .delete as the easiest, but it doesn't work. The "if not" works and goes through the .delete statement, but the .add(after...) fails.
I obviously have something wrong and any input is appreciated.
Dim wkb as excel.workbook
Dim wksheetname as excel.worksheet
Dim strsheetname as string
wkb.Activate
On Error Resume Next
Set wksSheetName = wkb.Sheets(StrSheetName)
On Error GoTo 0
If Not wksSheetName Is Nothing Then
wkb.Sheets(StrSheetName).Delete
Set wksSheetName = Nothing
End If
wkb.Sheets.Add(After:=wkb.Sheets(wkb.Sheets.Count)).Name = StrSheetName
Set wksSheetName = wkb.Sheets(StrSheetName)
This somewhat simpler method works here:
Const WorksheetName As String = "Sheet2"
Dim Workbook As Excel.Workbook
Dim Worksheet As Excel.Worksheet
Set Workbook = ThisWorkbook
For Each Worksheet In Workbook.Worksheets
If Worksheet.Name = WorksheetName Then
Worksheet.Delete
Exit For
End If
Next
Set Worksheet = Workbook.Worksheets.Add(After:=Workbook.Worksheets(Workbook.Worksheets.Count))
Worksheet.Name = WorksheetName
Related
I used this example, as follows, from Microsoft Docs website and received the message Sheets.Add returns a 1004 Method 'Add' of object 'Sheets' failed.
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
Please advise solution.
I wouldn't use 'sheet' as a variable name
After:= requires a sheet object, not a number
Could be
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets(1)))
Sorry if errors in code, written on my phone.
Sheet is reserved keyword. So, try another name using below sub.
Sub addsh()
Dim wb As Workbook
Dim sh As Worksheet
Set wb = ThisWorkbook
Set sh = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
Set sh = Nothing
Set wb = Nothing
End Sub
To add a sheet with name use below sub.
Sub addsh()
Dim wb As Workbook
Set wb = ThisWorkbook
wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = "MyNewSheet"
End Sub
See this answer from #Siddharth
I have multiple workbooks with worksheet named 'SUMMARY-F'. I need to combine these worksheets into one workbook and I am using the below code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
End If
Next
Set wkb = Nothing
End Sub
The code worked perfectly about 4 times however now when I run it, I get a subscript out of range error 9. Any tips on how to fix this?
Thanks,
Lucinda
If you have a workbook that is open that doesn't contain a sheet called SUMMARY-F you'll get an out-of-range error because Excel can't find a sheet with the specified name. This error will also apply to hidden workbooks such as a PERSONAL.xlsm if you've used it to record macros.
You should include a check in your code to handle the case when an open workbook doesn't have a sheet called SUMMARY-F.
See this question that gives options on how to identify if a sheet exists, such as defining a function that could be called from your code first:
How to check whether certain sheets exist or not in Excel-VBA?
You'll just need to modify it to check a sheet in another workbook, something like:
Public Function CheckSheet(ByVal sWB As String, ByVal sSheetName As String) As Boolean
Dim oSheet As Excel.Worksheet
Dim bReturn As Boolean
For Each oSheet In Workbooks(sWB).Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function
Then you can add a check in your code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
If CheckSheet(wkb.Name,sWksName)
wkb.Worksheets(sWksName).Copy Before:=ThisWorkbook.Sheets(1)
End If
End If
Next
Set wkb = Nothing
End Sub
The below code sometimes produces the error "Unable to use the paste method". Sometimes it does, sometimes it doesn't - even though I run the macro on the exact same files.
Can you figure out why or propose a more stable method?
Set x = srcWbk.Sheets("C").OLEObjects("MCFB")
Set y = x.Duplicate
xName = x.Name
y.Cut
trgtWbk.Sheets("C").Activate
trgtWbk.Sheets("C").Range("O1").Select
With trgtWbk.Sheets("C")
.Paste
.OLEObjects(.OLEObjects.Count).Name = xName
.Activate
End With
this is a temporary answer. it will be deleted when the OP sees the code
copied the buttons about one hundred times with no errors. Make sure your trgtWbk is properly closed and references are free'd. I cant see the entire code and how you manipulate your workbook object so it's very hard to tell why you are getting the error.
try re-arranging your code to best suit the below schema
Sub Main()
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("C:\Users\...\Desktop\Book2.xlsm")
CopyActiveX "cmd1", wb1, wb2
CopyActiveX "cmd2", wb1, wb2
wb2.Save
wb2.Saved = True
wb2.Close
Set wb2 = Nothing
End Sub
Sub CopyActiveX(cName As String, ByRef srcWbk As Workbook, ByRef trgtWbk As Workbook)
Dim x As OLEObject
Dim y As OLEObject
Dim xName As String
Set x = srcWbk.Sheets("C").OLEObjects(cName)
Set y = x.Duplicate
xName = x.Name
y.Cut
trgtWbk.Sheets("C").Activate
trgtWbk.Sheets("C").Range("O1").Select
With trgtWbk.Sheets("C")
.Paste
.OLEObjects(.OLEObjects.Count).Name = xName
.Activate
End With
End Sub
What I need is a way to send the contents of some cells in "ThisWorkbook" (where the macro is) to a specific sheet in another workbook (the location of which will not change, unlike "ThisWorkbook")
for some reason, this below dosen't work:
Sub Transplant()
Dim thispath As String
Dim targetpath As String
'Set filepaths
thispath = ThisWorkbook.FullName
targetpath = ThisWorkbook.Path & "/subdir/Targetbook.xlsm"
Dim Srcwb As Workbook
Dim Trgwb As Workbook
'Set workbooks
Set Srcwb = Workbooks.Open(thispath)
Set Trgwb = Workbooks.Open(targetpath)
Srcwb.Worksheets("Sheet1").Range(Srcwb .Worksheets("Sheet1").Range("A1"), _
Srcwb.Worksheets("Sheet1").Range("A1").End(xlToRight)).Copy _
Destination:=Trgwb.Sheets("Sheet1").Cells(1, 1)
End Sub
Please help!
//Leo
This is pretty much the same as what you've got, although I didnt re-open the active workbook.
Can you describe the range you're trying to copy? You might find that UsedRange is easier.
Sub Transplant()
Dim DWB As Workbook
Dim S As Worksheet
Set S = ThisWorkbook.WorksheetS("Sheet1") ' forgot to rename Source to S
Set DWB = Application.Workbooks.Open(Thisworkbook.Path & "/subdir/Targetbook.xlsm")
Set D = DWB.Worksheets("Sheet1")
S.Range(S.Range("A1"), S.Range("A1").End(xlToRight)).Copy Destination:=D.Cells(1,1)
' S.UsedRange.Copy Destination:=D.Cells(1,1) - this might be easier
End Sub
So I'm using this macro to extract only the data that I need to perform a regression, and the sample set includes quite a bit of useless information for my needs. When I try to select the columns from the CCDetail workbook- I get the "'Range' of object '_Global' Failed" error. Any ideas on why this is?
Sub ExtractCCDetail()
Dim WorkbookName As String
Dim CCDetail As Workbook
Dim Harvester As Workbook
Dim RAWData As Worksheet
Set CCDetail = Workbooks(2)
Set Harvester = ThisWorkbook
WorkbookName = CCDetail.Name
CCDetail.Activate
Set RAWData = Worksheets("Department Totals")
RAWData.Select
'This is where the code will break
Range( _
"D:D,E:E,F:F,M:M,X:X,Y:Y,Z:Z,AA:AA,AC:AC,AD:AD,AE:AE,AF:AF,BD:BD,BF:BF," _
).Select
Selection.Copy
Harvester.Activate
Sheets.Add After:=Sheets(Worksheets.Count), Count:=1
ActiveSheet.Name = WorkbookName
ActiveSheet.Paste
End Sub
*As a side note- I have tested doing this manually and I don't have a problem. I have also tried calling
ActiveSheet.Range (wanted Range)
RAWData.Range (wanted range)
But neither of these have worked.
The problem is that you have an extra comma in the arguments for your Range. Try this instead:
Range("D:D,E:E,F:F,M:M,X:X,Y:Y,Z:Z,AA:AA,AC:AC,AD:AD,AE:AE,AF:AF,BD:BD,BF:BF").Copy
If you want to clean up your code a bit and avoid Selects and such, try this out:
Sub ExtractCCDetail()
Dim WorkbookName As String
Dim CCDetail As Workbook
Dim Harvester As Workbook
Dim RAWData As Worksheet
Set CCDetail = Workbooks(2)
Set Harvester = ThisWorkbook
WorkbookName = CCDetail.Name
Set RAWData = CCDetail.Worksheets("Department Totals")
RAWData.Range("D:D,E:E,F:F,M:M,X:X,Y:Y,Z:Z,AA:AA,AC:AC,AD:AD,AE:AE,AF:AF,BD:BD,BF:BF").Copy
Dim wksCopy As Worksheet
Set wksCopy = Harvester.Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1)
With wksCopy
.Paste
.Name = WorkbookName
End With
End Sub