Excel VBA将工作表复制到新工作簿，并重命名基于工作表的单元格值

Question

我正在尝试将一个工作表“RESULTADOS”复制到具有基于工作表名称的单元格值范围“U3”的新工作簿。我的代码很好地复制了工作表，但它给出了关于名称的错误，并且新文件无法正常打开，所以我不知道它的错误在哪里。希望能有所帮助。

我的代码：

Sub CopySheetToNewWorkbook()

Dim wFrom As Workbook
Dim wTo   As Workbook

Set wFrom = ActiveWorkbook
Set wTo = Workbooks("FileResult.xlsx")

With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
End With

With wFrom
  .Sheets("RESULTADOS").Range("A1:Y100").Copy
End With

With wTo
  With .Sheets("HOJA1")
       .Range("A1").PasteSpecial Paste:=xlPasteAll
       .name = wFrom.Sheets("RESULTADOS").Range("U3").Value
  End With
End With

With Application
  .ScreenUpdating = True
  .DisplayAlerts = True
End With
End Sub

提前谢谢你。

工作表“RESULTADOS”上的对象图未复制到新工作簿中。复制条形图对象的参数是什么？

更新代码：

Sub CopySheetToNewWorkbook()

Dim wbFrom As Workbook
Dim wbTo   As Workbook
Set wbFrom = ThisWorkbook
Set wbTo = "D:\FileResult.xlsx"

Application.ScreenUpdating = False

With wbTo
    With .Sheets(.Sheets.Count)
       wbFrom.Sheets("RESULTADOS").Range("A1:Y100").Copy
       .Range("A1").PasteSpecial
       .Range("A1").PasteSpecial xlPasteColumnWidths
       .Name = wbFrom.Sheets("RESULTADOS").Range("U3").Value
    End With
    .Worksheets.Add After:=.Sheets(.Sheets.Count)
    .Save
End With

Application.ScreenUpdating = True

End Sub

Answer 1

从一个工作簿复制到另一个工作簿

PasteType

Option Explicit

Sub CopySheetToNewWorkbook()

    Dim wbFrom As Workbook
    Dim wbTo   As Workbook
    Set wbFrom = ThisWorkbook
    Set wbTo = Workbooks.Open(ThisWorkbook.Path & "\FileResult.xlsx")
    
    Application.ScreenUpdating = False
    
    With wbTo
        With .Sheets("HOJA1")
           wbFrom.Sheets("RESULTADOS").Range("A1:Y100").Copy
           .Range("A1").PasteSpecial
           .Range("A1").PasteSpecial xlPasteColumnWidths
           .Name = wbFrom.Sheets("RESULTADOS").Range("U3").Value
        End With
        .Worksheets.Add After:=.Sheets(.Sheets.Count)
        ActiveSheet.Name = "HOJA1"
        '.Save
        '.Close
    End With
    
    Application.ScreenUpdating = True

End Sub