![]() |
Excel VBA won't copy Worksheets after sheet Deletion
So, I've written some code that reads through a list of sheets, and in
the event a given sheet can NOT be found in the workbook, the code copies a "Template" sheet and names it after the missing sheet. The code runs beautifully the first time. Any time there is a missing sheet on the list, the code copies the "Template" sheet and renames it, accordingly. Where the code runs into problems is upon sheet deletion. If I select a range of sheets (manually) and delete them from the workbook, the code is unable to access the "Copy Worksheets" method upon re-run. I have seen others post about this bug in Excel and am wondering if anyone knows/has a work-around. Here is the code. It is a bit complicated as it uses Global Variables, but hopefully the names make sense. Please ask questions or offer advice. Thanks, Thaddeus -------------------- Option Explicit Option Base 1 ''set the first array address to 1 instead of zero. Sub ADD_TEMPLATE_SHEETS() ' ' Written 5/25/2007 by tagar ' Dim cntsheet As Long '''The count of sheets in the book at the start of sub. Dim cntsheetplus As Variant '''A counter on the increment of sheets, used to add new sheets to the end of the book. Dim nmSheet As Variant '''used to iterate through cntsheets Dim nmAddSheet As Variant '''the name of the sheet to check and add Dim addTarget As Variant '''target boolean to determine if sheet exists Dim i As Long '''Page counter for lngRowMax Dim j As Long '''Page counter for lngColMax Dim lngRowCount As Long '''the counter column number Dim lngColCount As Long '''the actual column number Dim sheetArray() As Variant ''' Dim arrayIndex As Long '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''' ''' '''Get Global Variables!! ''' PROJECT_GLOBALS.GET_GLOBALS Workbooks(nmWorkbook).Activate cntsheet = Workbooks(nmWorkbook).Worksheets.Count '''Get the count of worksheets in the workbook cntsheetplus = cntsheet '''assign the initial value to cntsheetsplus ''''enter all sheet names into an array ReDim sheetArray(1 To cntsheet + 10) For nmSheet = 1 To cntsheet sheetArray(nmSheet) = Sheets(nmSheet).Name Next nmSheet lngColCount = Worksheets(nmConsoleSheet).Cells(24, 6).End(xlToRight).Column - 5 lngRowCount = Worksheets(nmConsoleSheet).Cells(24, 5).End(xlDown).Row - 24 For i = 1 To lngRowCount '''for each sheet to add (row) For j = 1 To lngColCount '''for each data type (column) addTarget = 0 '''Display Work Update Status Sheets(nmConsoleSheet).Activate Sheets(nmConsoleSheet).Cells(19, 4).Value = "Checking " & nmAddSheet Application.DisplayAlerts = True Application.ScreenUpdating = True Application.DisplayAlerts = False Application.ScreenUpdating = False For arrayIndex = 1 To cntsheet '''check to see if sheet already exists in workbook. '''Assemble the name of the sheet to check/add if missing If arrayIndex = 1 Then nmAddSheet = Workbooks(nmWorkbook).Sheets(nmConsoleSheet).Cells (i + 24, 5).Value & "-" & Sheets(nmConsoleSheet).Cells(24, j + 5).Value End If If sheetArray(arrayIndex) = nmAddSheet Then addTarget = 1 ''''Get the name if sheet exists arrayIndex = cntsheet 'MsgBox ("Do Nothing") End If Next arrayIndex '''check all sheets to see if nmAddSheet already exists. If yes, do nothing. If addTarget = 0 Then Workbooks(nmWorkbook).Sheets(nmTemplateSheet).Copy After:=Workbooks(nmWorkbook).Sheets(Sheets.Count) '(cntsheetplus) Workbooks(nmWorkbook).Sheets(nmTemplateSheet & " (2)").Name = nmAddSheet cntsheetplus = cntsheetplus + 1 '''since the sheet was added, increment cntsheetsplus so the next sheet will still be added to the end of the workbook. End If Next j '''continue for each Data Type (columns) Next i '''continue for all sheets to be checked/added (rows) '''Display Work Update Status Sheets(nmConsoleSheet).Activate Sheets(nmConsoleSheet).Cells(19, 4).Value = "Complete" Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub |
Excel VBA won't copy Worksheets after sheet Deletion
|
Excel VBA won't copy Worksheets after sheet Deletion
On Jun 1, 12:12 pm, "Don Guillett" wrote:
Might be easier? Assumes you have a list Sub makesheetifnotonlist() For Each c In Range("mylist") On Error Resume Next If Worksheets(c.Value) Is Nothing Then Sheets("Template").Copy after:=Sheets(Sheets.Count) ActiveSheet.Name = c End If Next c End Sub -- Don Guillett SalesAid Software wrote in message oups.com... Not sure this resolves the issue though. The problem is that once a large range of sheets are deleted from a workbook, it is not possible (manually or otherwise) to copy an existing sheet. Right now, I am not under the impression that this is related to the code. Thanks for the suggestion. I will see if it works give the way my list is matrixed. |
Excel VBA won't copy Worksheets after sheet Deletion
I modified your code slightly in order to handle the matrixed nature
of my data entry. The code looks like this. However, I am still getting the same error in excel. Once a significant number of pages are generated, if you delete a bunch of them and then run the code again, it will fail on the Worksheet Copy method. Can you please try this and see if you can confirm? After 1 or two times, I get the error/issue. Sub makesheetifnotonlist() For Each c In Sheets("Console").Range("mylist_1") For Each d In Sheets("Console").Range("mylist_2") On Error Resume Next If Worksheets(c & "-" & d.Value) Is Nothing Then Sheets("Template").Copy after:=Sheets(Sheets.Count) ActiveSheet.Name = c & "-" & d End If Next d Next c End Sub Enter a lower-case "x" for each Data Type that should be excluded during page generation. Tables Figures Text Drawings Tab Name T F X D 1 x 2 x 3 x 4 x 5 x 6 x 7 x |
Excel VBA won't copy Worksheets after sheet Deletion
The data is in an X by Y array. For each X there is 1 or more Ys.
There is a drawing at the bottom of my previous post. In any event, I'm not sure that matters much. The issues I encounter with either set of codes is as follows. If you use the code to generate 100-200 worksheets and then delete all 100-200 worksheets, the code will encounter an error once you run it again. The error is intermittent. It does not occur at a specific point during subsequent runs. Sometimes it happens immediately. Other times it happens on the 2nd or 3rd run. Please run your code several times, follow this procedure, and let me know if you encounter the issue. |
All times are GMT +1. The time now is 01:09 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com