简体   繁体   English

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

[英]Excel VBA Copy sheet to new workbook with rename sheet based cell value

I am trying to copy one sheet "RESULTADOS" to new workbook with sheet name based cell value range "U3".我正在尝试将一张工作表“RESULTADOS”复制到新工作簿中,并使用基于工作表名称的单元格值范围“U3”。 My code copies the sheet fine but it is giving error about name and the new file not open fine so i dont know where its mistake.我的代码很好地复制了工作表,但它给出了关于名称的错误,并且新文件无法正常打开,所以我不知道它的错误在哪里。 I hope some help.我希望一些帮助。

My code:我的代码:

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

Thank you in advance.先感谢您。

The object graph on sheet "RESULTADOS" not copy in new workbook.工作表“RESULTADOS”上的对象图未复制到新工作簿中。 What parameter is to copy the bar graph objects?复制条形图对象的参数是什么?

UPDATE code:更新代码:

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

Copy From One Workbook to Another从一个工作簿复制到另一个

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM