|
-
Mar 3rd, 2014, 10:57 AM
#1
Thread Starter
Junior Member
[RESOLVED] Excel 2010 freezing when renaming multiple sheets
Hi everyone. I posted the macro below. I have a list of codes on my "Start Tab". From there I have a few macros that run before this one that takes the list of codes and creates a tab in the workbook for each code. Once that is done, the below macro goes to a specific URL code on our Intranet and opens it, copies it to the worksheet with the associated code. That's the whole code. Each time I run this part of the macro, Excel freezes. It's never in the same place. Sometimes it freezes very quickly, sometimes it runs through almost the entire list of 600 codes. Can you see what the issue is? I'm at a loss. I have googled this and looked everywhere for a solution but I can't find one. Please help!!!!!!!
Sub Update_Client_Tabs()
'Application.DisplayAlerts = False
Sheets("Start Tab").Select
Range("F7").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
sourcesheet = ActiveSheet.Name
For Each Cell In Selection
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Cell.Value
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename"",RC),FIND(""]"",CELL(""filename"",RC))+1,256)"
Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=INDEX('Start Tab'!C6:C9,MATCH(R1C1,'Start Tab'!C6,0),4)"
Range("B1").Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",R1C1)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A1000"), Type:=xlFillDefault
Range("A2:A1000").Select
Selection.FillDown
Dim qtsQueries As QueryTables
Dim qtQuery As QueryTable
Set qtsQueries = ActiveSheet.QueryTables
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("B2").Value, _
Destination:=ActiveSheet.Range("b4"))
.Name = Range("B2").Value
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("$A$2:$A$1000").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
On Error Resume Next
Rows("1:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("3:3").Select
ActiveWindow.FreezePanes = True
Range("A4").Select
ActiveSheet.Buttons.Add(800, 5, 45, 25).Select
Selection.OnAction = "Back"
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "Back"
Range("C1").Select
ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename"",RC[-2]),FIND(""]"",CELL(""Filename"",RC[-2]))+1,256)"
Worksheets(Worksheets.Count).Activate
Sheets(sourcesheet).Activate
Next Cell
'Application.DisplayAlerts = False
'Application.DisplayAlerts = True
Sheets("Start Tab").Select
End Sub
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|