Copier la feuille de calcul dans un nouveau classeur et modifier le nom de la feuille de calcul en nom de composition

Question

Je copie de nombreux classeurs dans un classeur, mais comme toutes les feuilles de calcul du même classeur portent le même nom, et chaque classeur possède le même nom. nom du fichier sur B1, donc je veux nommer la nouvelle feuille comme « violation (nom) »

C'est le code que j'ai pour cette partie

Dim wc As Worksheet 
Dim ws As Worksheet 
Dim SheetNewName As String 
Dim Parname As String 
Dim SheetName As String 

Select Case wc.Cells(n, 1) 
    Case "PK" 
     SheetName = "Peak" 
    Case "Sfactor" 
     SheetName = "SF Supply" 
    Case Else 
     SheetName = wc.Cells(n, 1) 
End Select 

Set ws = ThisWorkbook.Sheets("Sheet1") 
Set wc = ActiveWorkbook.Sheets("Violations Summary") 
Set Parname = wc.Range("B1") 
Set SheetNewName = SheetName & "(" & Parname & ")" 

ActiveWorkbook.Sheets(SheetName).Copy After:=ThisWorkbook.Sheets(1) 
Set lastsheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.count).Select 
lastsheet.Name = SheetNewName 

je reçois l'erreur en essayant de changer le nom de la nouvelle feuille sur le nouveau classeur, l'erreur est

Erreur d'exécution '13': incompatibilité de type

Sur ces lignes

Set SheetNewName = SheetName & "(" & Parname & ")" 

Mais si je modifie le code pour être comme ces

Set Parname = wc.Range("B1") 
Set SheetNewName = SheetName & "(" & Parname & ")" 

ActiveWorkbook.Sheets(SheetName).Copy After:=ThisWorkbook.Sheets(1) 
Set lastsheet = ThisWorkbook.Sheets(1).Select 
lastsheet.Name = Parname 

Il copie la feuille, mais ne pas changer le nom et obtenir l'erreur

Erreur d'exécution '1004': définie par l'application ou une erreur définie objet-

Answer 1

Vous ne pouvez pas "SET" comme variable de chaîne:

Set SheetNewName = SheetName & "(" & Parname & ")" 

doit être modifié pour

SheetNewName = SheetName & "(" & Parname & ")" 

et

Set Parname = wc.Range("B1") 

besoins t o être

Parname = wc.Range("B1")