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

 

[fari1]

compile error
invalid use of object

and it highlights nothing in this code line

 If testSheet Is Not Nothing Then

 

[JackDanIce]

Typo (again!). 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

 

[fari1]

same error again, same portion highlighted

 

[JackDanIce]

Change that line to:

 If Not (testSheet Is Nothing) Then

 

[fari1]

now no error, but still its not copying data in already present sheet,for new sheet its working like great

 

[JackDanIce]

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

What do you want it to do if the sheet already exists, paste or not paste?

 

[fari1]

code has to paste data in any case, if the sheet is present or not, the difference is, if the sheet is present(matches the cell value) then paste in it, else creates a new sheet and pastes into it and rename it

 

[JackDanIce]

It should be doing it. Made a tiny adjustment, 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 Not (testSheet Is Nothing) Then
         .testSheet.Range("A1").PasteSpecial Paste:=xlValues
      Else
         Worksheets.Add().Name = "NewSheet"
         With .Sheets("NewSheet")
             .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

 

[fari1]

no, still its not, i dun know why