VBA code to create sheet in new workbook and rename it

[fari1]

Hi,
i'm seeking for a vba code for my following issue
.
the code does match this cell value from oldworkbook with all the sheetnames in the newworkbook, if it finds the sheetname that matches value, it copies a range F1 to H1 in its cell A1, else it create a new sheet and rename it with the cell value and paste the range.
any help on it is greatly appreciated

my code is

Option Explicit
Sub copyDataToClosedWorkbook()
    Dim wbTo   As Workbook
    Dim wbFrom As Workbook
    Set wbFrom = ActiveWorkbook
    Set wbTo = Workbooks.Open("C:\Project\Final.xlsm", _
                              False, True)
    With wbFrom
    wbFrom.Sheets("ratios").Range("k1:Aj6").Copy
    End With
    
    Application.ScreenUpdating = False
    With wbTo
    wbTo.Sheets("Sheet1").Name = wbFrom.Sheets("webquery").Range("A1").Value.Activate
    ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues, Transpose:=True
    Worksheets.Add().Name = ("sheet1")
End With
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    wbTo.ChangeFileAccess Mode:=xlReadWrite
    wbTo.Close SaveChanges:=True
End Sub

 

[JackDanIce]

Can see some mistakes in your code. Try:

Option Explicit
Sub copyDataToClosedWorkbook()

    Dim wbTo   As Workbook
    Dim wbFrom As Workbook

    Set wbFrom = ActiveWorkbook
    Set wbTo = Workbooks.Open("C:\Project\Final.xlsm", False, True)

    With wbFrom
      .Sheets("ratios").Range("K1:AJ6").Copy
    End With
    
    With Application
      .ScreenUpdating = False
      .DisplayAlerts = False
    End With

    With wbTo
      With .Sheets("Sheet1")
           .Range("A1").PasteSpecial Paste:=xlValues
           .Name = wbFrom.Sheets("webquery").Range("A1").Value.Activate
      End With
      Worksheets.Add().Name = ("Sheet1")
    End With

    wbTo.ChangeFileAccess Mode:=xlReadWrite
    wbTo.Close SaveChanges:=True

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

End Sub

 

[fari1]

hi jack thanks for the quicki reply
the code is giving me the runtime error424 object required

 

[fari1]

it is highlighting this part of the code

.Name = wbFrom.Sheets("webquery").Range("A1").Value.Activate

 

[JackDanIce]

You're welcome. What line is that error on?

 

[JackDanIce]

Missed that. Change it to:

.Name = wbFrom.Sheets("webquery").Range("A1").Value

 

[fari1]

the code is working like a charm, BUT
i want the code to work like this, to match the cell value with the sheet names in newworkbook, if the sheet exists paste the range else create new sheet and rename it with cell value and paste the range. hope i didn't confuse you

 

[JackDanIce]

See if this works:

Option Explicit
Sub copyDataToClosedWorkbook()

    Dim wbTo   As Workbook
    Dim wbFrom As Workbook
    Dim testSheet As WorkSheet

    Set wbFrom = ActiveWorkbook
    Set wbTo = Workbooks.Open("C:\Project\Final.xlsm", False, True)

    With wbFrom
      .Sheets("ratios").Range("K1:AJ6").Copy
    End With
    
    With Application
      .ScreenUpdating = False
      .DisplayAlerts = False
    End With

    With wbTo
      On Error Resume Next
      Set testSheet = Sheets(wbFrom.Sheets("webquery").Range("A1").Value)
      If testSheet Is Nothing Then
         Worksheets.Add().Name = ("Sheet1")         
         With .Sheets("Sheet1")
             .Range("A1").PasteSpecial Paste:=xlValues
             .Name = wbFrom.Sheets("webquery").Range("A1").Value
        End With
      Else
        .Sheets(wbFrom.Sheets("webquery").Range("A1")).Range("A1").PasteSpecial Paste:=xlValues
      End If
    End With

    wbTo.ChangeFileAccess Mode:=xlReadWrite
    wbTo.Close SaveChanges:=True

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

End Sub

 

[fari1]

the code is great i guess, but the only problem if a sheet already exists that matches cell value, it doesn't copy data into that sheet and also dun give me any error, i mean it completes the process without copying, else it works great

 

[JackDanIce]

Try:

Option Explicit
Sub copyDataToClosedWorkbook()

    Dim wbTo   As Workbook
    Dim wbFrom As Workbook
    Dim testSheet As WorkSheet

    Set wbFrom = ActiveWorkbook
    Set wbTo = Workbooks.Open("C:\Project\Final.xlsm", False, True)

    With wbFrom
      .Sheets("ratios").Range("K1:AJ6").Copy
    End With
    
    With Application
      .ScreenUpdating = False
      .DisplayAlerts = False
    End With

    With wbTo
      On Error Resume Next
      Set testSheet = Sheets(wbFrom.Sheets("webquery").Range("A1").Value)
      If testSheet Is Not Nothing Then
         .testSheet.Range("A1").PasteSpecial Paste:=xlValues
      Else
         Worksheets.Add().Name = ("Sheet1")         
         With .Sheets("Sheet1")
             .Range("A1").PasteSpecial Paste:=xlValues
             .Name = wbFrom.Sheets("webquery").Range("A1").Value
        End With
        On Error Goto 0
      Else
      End If

    wbTo.ChangeFileAccess Mode:=xlReadWrite
    wbTo.Close SaveChanges:=True

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

End Sub