簡體   English   中英

Excel VBA 將工作表復制到新工作簿並重命名基於工作表的單元格值

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

我正在嘗試將一張工作表“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

從一個工作簿復制到另一個

粘貼類型

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