Kais
Kais

Reputation: 15

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". 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. 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

Upvotes: 0

Views: 3044

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

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

Upvotes: 1

Related Questions