Copying a Range to a Worksheet with same Format-CodePudding

Hi I have an issue with my code. I'm creating 4 new sheets and I'm copying a table into each one (dbR) and a range Range("B8:K8") which is a header. I'm trying to maintain the format of this range while copying, but when I run this code, the row flickers and copies nothing without showing error. Is there something I'm missing? I'm fairly new so I expect my code looks quite poor.

Sub CreateSheets()
 

Dim rng As Range: Set rng = ThisWorkbook.Worksheets("Configuration").Range("Vendors[Vendors]")
Dim dbR As Range: Set dbR = Sheets("Configuration").ListObjects("Client_Responses").DataBodyRange
Dim Ws_Name As String


For Each cell In rng
        Ws_Name = cell
        Worksheets.Add.Name = cell
        ActiveSheet.Name = cell
        dbR.Copy Destination:=Range("B2")
        Worksheets("Configuration").Range("B8:K8").Copy
        Worksheets(Ws_Name).Range("B1").PasteSpecial Paste:=xlPasteColumnWidths

Next cell
End Sub

CodePudding user response：

Just add the multiple desired 'special paste's:

Sub CreateSheets()

    Dim rng As Range: Set rng = ThisWorkbook.Worksheets("Configuration").Range("Vendors[Vendors]")
    Dim dbR As Range: Set dbR = Sheets("Configuration").ListObjects("Client_Responses").DataBodyRange
    Dim Ws_Name As String
    
    Dim cell
    For Each cell In rng
            Ws_Name = cell
            Worksheets.Add.Name = cell
            ActiveSheet.Name = cell
            dbR.Copy Destination:=Range("B2")
            Worksheets("Configuration").Range("B8:K8").Copy
            Worksheets(Ws_Name).Range("B1").PasteSpecial xlPasteColumnWidths
            Worksheets(Ws_Name).Range("B1").PasteSpecial xlValues
            Worksheets(Ws_Name).Range("B1").PasteSpecial xlFormats
    
    Next cell
End Sub