updating a macro code

[Dartit]

Hiya and happy new year.

I recieved excellent help with my macro code last year, and i have dissected the code to see if i could not learn how it works and to an extent i have managed to

However, I am struggeling to add inn new code into the existing one. I want to add inn bold font for the titles in TitlB when the new sheets are created and i would like for the cells to autofit in the new sheets created when the macro is run.

Macro code i have:

Sub SerieNR()


Dim Ws As Worksheet
Dim Ary As Variant
Dim i As Long, j As Long
Dim Cl As Range
Dim UsdRws As Long
Dim TitlA As Variant
Dim TitlB As Variant
Dim FName As String
Dim FPath As String


Application.ScreenUpdating = False


TitlA = Array("identifikator", , "Opprett/endre utstyr", , "Mottaksbekreftelse")
TitlB = Array("Modell", "Produkt nr", "serie nr", "Materiell nr", "Mottatt dato", "lager kode")
Set Ws = Sheets("Data")
FPath = "\\mil.no\L\FMA IKT LEVKOORD REALISERING\02 IKT-ATEA\SAP REGISTRERING\Rapporter Fra Atea\02_Materielltransaksjon"
FName = Ws.Range("E2").Text
ThisWorkbook.SaveAs Filename:=FPath & "" & FName

If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
UsdRws = Ws.Range("C" & Rows.Count).End(xlUp).Row
With CreateObject("scripting.dictionary")
For Each Cl In Ws.Range("C2:C" & UsdRws)
If Not .exists(Cl.Value) Then
.Add Cl.Value, Nothing
If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
Sheets(Cl.Text).Range("A1:E1").Value = TitlA
Sheets(Cl.Text).Range("A2:F2").Value = TitlB
End If
Ws.Range("A1:D1").AutoFilter 3, Cl.Value
Ary = Ws.Range("A2:D" & UsdRws).SpecialCells(xlVisible)
j = UBound(Ary, 2)
For i = 1 To UBound(Ary, 1)
Sheets(Cl.Text).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Ary(i, j)).Value = Ary(i, 1)
Sheets(Cl.Text).Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(Ary(i, j)).Value = Ary(i, 2)
Sheets(Cl.Text).Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(Ary(i, j)).Value = Ary(i, 3)
Next i
Ary = ""
End If
Next Cl
End With
Ws.AutoFilterMode = False
Ws.Activate
Ws.Delete


End Sub

Thank you very much for the time and help in this matter.

 

[kvsrinivasamurthy]

Add This line as below

[COLOR=#333333]Sheets(Cl.Text).Range("A2:F2").Value = TitlB[/COLOR]
[COLOR=#333333]End If[/COLOR]

as

[COLOR=#333333]Sheets(Cl.Text).Range("A2:F2").Value = TitlB
[/COLOR][COLOR=#ff0000]Sheets(Cl.Text).Range("A2:F2").Font.Bold = True[/COLOR]
[COLOR=#333333]End If[/COLOR]

 

[Dartit]

Hiya

Thank you for reply.

I added the line Sheets(C1.Text).Range("A2:F2").Font.Bold = True , however when i run the code i get object required erros 424.
Im unsure why i recieve this erros as the object is C1.Text, as i understand it.

Thank you for your time.

 

[kvsrinivasamurthy]

C1.Text should be Worksheet name.

 

[Dartit]

Ah, figured it out.

Cheers now it works perfectly.

Again thank you very much for your time and help