VBA Code doesnt break links to the new worksheet

DharmaK

New Member
Joined
Jul 28, 2021
Messages
7
Office Version
  1. 365
Platform
  1. Windows
Sub CopyInNewWB()

Dim wbN As Workbook
Dim xSht As Worksheet, xNSht As Worksheet
Dim i As Long, xCName As Long
Dim dic As Object, ky As Variant, lnk As Variant
Dim xTitle As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set xSht = ThisWorkbook.Sheets("Template")
Set dic = CreateObject("Scripting.Dictionary")

xCName = 2 'Change this number to the column number which you will create new sheets based on
xTitle = "A:J"

For i = 2 To xSht.Cells(Rows.Count, xCName).End(xlUp).Row
If xSht.Cells(i, xCName).Value <> "" Then dic(xSht.Cells(i, xCName).Value) = xSht.Cells(i, "A").Value
Next

For Each ky In dic.keys
ThisWorkbook.Sheets("CoverPage").Copy
Set wbN = ActiveWorkbook
xSht.Range(xTitle).AutoFilter xCName, ky
Set xNSht = Worksheets.Add(, wbN.Sheets(wbN.Sheets.Count))
xNSht.Name = ky
ActiveWindow.DisplayGridlines = False
xSht.AutoFilter.Range.EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit

'save workbook
wbN.SaveAs ThisWorkbook.Path & "\" & dic(ky) & " - " & ky
wbN.Close False

Next

On Error Resume Next
With ActiveWorkbook
For Each lnk In .LinkSources(Type:=xlLinkTypeExcelLinks)
.BreakLink Name:=lnk, Type:=xlLinkTypeExcelLinks

Next
End With
On Error GoTo 0
xSht.AutoFilterMode = False


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Forum statistics

Threads
1,213,557
Messages
6,114,287
Members
448,562
Latest member
Flashbond

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