Copy sheet looses focus when formatting

wmtsub

Active Member
Joined
Jun 20, 2018
Messages
322
I am trying to copy a worksheet to a new workbook and change the formatting. But the macro only changes the formatting on the original workbook. How do I gain focus on the new workbook?



Sub Copy_WorkSheet()

'open and copy sheet to new wb
Sheets("Sheet 1").Select
ActiveSheet.UnProTect
Sheets("Sheet 1").Copy

'change table style
ActiveSheet.ListObjects("VendComplete").TableStyle = "TableStyleMedium4"

'remove hidden hyperlink
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Selection.Cut

'close original wb
Windows("Supplier List_working.xlsm").Activate
Application.ThisWorkbook.Saved = True
ActiveWorkbook.Close
End Sub
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Nowhere in your code do you paste. Once you've pasted you can then re-format
 
Upvote 0
@gallen
This part "Sheets("Sheet 1").Copy" opens new workbook and pastes copied WS.

@
wmtsub

As for loosing focus...
I cannot reproduce the problem. Anyway you could try to modify this part:
"'change table style
ActiveSheet.ListObjects("VendComplete").TableStyle = "TableStyleMedium4""

To this:

Code:
[/COLOR][COLOR=#333333]'change table style
[/COLOR]Activeworkbook.[COLOR=#333333]Sheets("Sheet 1").[/COLOR][COLOR=#333333]ListObjects("VendComplete").TableStyle = "TableStyleMedium4"

[/COLOR][COLOR=#333333]'remove hidden hyperlink[/COLOR]
Activeworkbook.[COLOR=#333333]Sheets("Sheet 1")[/COLOR][COLOR=#333333].Shapes.Range(Array("Picture 1")).Select[/COLOR]
[COLOR=#333333]Selection.Cut
[/COLOR][COLOR=#333333]

As new workbook should be main object after copy activeworkbook should do the trick.
 
Upvote 0
Thanks for the feedback.

The hyperlink removal works - thanks but this line stilltrows an erro:


'change table style
Activeworkbook.
Sheets("Sheet 1").
ListObjects("VendComplete").TableStyle = "TableStyleMedium4"
 
Upvote 0
Found a work around.

'remove hidden hyperlink

Activeworkbook.
Sheets("Sheet 1")
.Shapes.Range(Array("Picture 1")).Select

Selection.Cut

'change table style
Range("a1").Select
ActiveSheet.ListObjects(1).Unlist
Cells.Select
With Selection.Interior
.Pattern = xlNone
End With
With Selection.Font
.ColorIndex = xlAutomatic
End With
' New table Style
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$AY$617"), , xlYes).Name = "Table2"
Range("Table2[#All]").Select
ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleMedium11"
 
Upvote 0

Forum statistics

Threads
1,214,591
Messages
6,120,427
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top