Refresh formula in all the sheets after running macro

[mohammadimran]

Good Day everyone,

I am trying to copy Vendor names along with their relevant details into a new sheet. There are approx over 50 unique vendors in my sheet. My VBA macro works just and it takes all the vendors data into new worksheets with one addition that I also insert a row in every sheet and enter a formula in cell B1 and cell A1 in every new sheet.

The Issue I am facing is that after the macro is finished and I get all the sheets done. the data in cell B1 and A1 is not refreshed and instead its the same data in every sheet and I have to manually go to every sheet to update the cell values in B1 in order to update A1.

I have tried different combinations but failed so far. Any help is much appreciated.

My code is as follows;


Function GetWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = Worksheets(shtName)
End Function




Sub Copy_Data_to_New_Tabs()


Dim x As Range
Dim rng As Range
On Error GoTo Errorcatch
Dim last As Long
Dim sht As String




'specify sheet name in which the data is stored
sht = "Detail"


'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:J" & last)


Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BB1"), Unique:=True


For Each x In Range([BB2], Cells(Rows.Count, "BB").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy


Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste

'Adds a Row in every new sheet after pasting data and puts formula in Cell B1 and Cell A1



Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("B1").Formula = "=(REPLACE(CELL(""filename""),1,FIND(""]"",CELL(""filename"")),""""))"
Range("A1").Formula = "=VLOOKUP(B1,'C:\Users\mimran\Documents\Working - RMA\[Vendor Emails.xlsx]Sheet1'!$A:$B,2,0)"




End With
Next x


' Turn off filter
Sheets(sht).AutoFilterMode = False


With Application
.CutCopyMode = False
.ScreenUpdating = True




Exit Sub


Errorcatch:
MsgBox Err.Description


End With


End Sub

 

[JonXL]

Add

Calculate

at the end of your code.