• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 7244
  • Last Modified:

Copying One Excel Worksheet to Another Excel Spreadsheet file

I have two excel files.   BookA.xls and BookB.csv.  I would like to copy the entire sheet "Projects" which is in BookA.xls over to a new sheet in BookB.csv (which already exists and contains data on other sheets) by using VBScript.  

.. one other thing, the sheet "Projects" is dynamic and therefore using the Range.Copy as an option isnt really possible since one day this sheet could be 100 rows long or 10000 rows long etc etc

Can anyone help?
0
justastef
Asked:
justastef
2 Solutions
 
RobSampsonCommented:
Hi, this VBS script should do the job.  Specify your two workbook paths, and the sheet name.
It will not overwrite an existing sheet if it already exists in Workbook 2.

'====================
strBook1 = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Test.xls"
strBook2 = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Test2.xls"
strSheetToCopy = "Data"
Set objExcel = CreateObject("Excel.Application")
Const xlCalculationManual = -4135
Const xlCalculationAutomatic = -4105
objExcel.Visible = False
Set objWB1 = objExcel.Workbooks.Open(strBook1, False, False)
Set objWB2 = objExcel.Workbooks.Open(strBook2, False, False)
' Turn off screen updating so the macro runs faster
objExcel.ScreenUpdating = False
' Turn off automatic calculations so the macro runs faster
objExcel.Calculation = xlCalculationManual
' Check if the sheet name exists in the first workbook to copy it
boolExists = False
For Each objSheet In objWB1.Sheets
      If LCase(objSheet.Name) = LCase(strSheetToCopy) Then
            boolExists = True
            Exit For
      End If
Next
If boolExists = True Then
      ' Check if the sheet name already exists in the second workbook
      boolExists = False
      For Each objSheet In objWB2.Sheets
            If LCase(objSheet.Name) = LCase(strSheetToCopy) Then
                  boolExists = True
                  Exit For
            End If
      Next
      ' If the sheet does not exist in the second workbook, copy the
      ' sheet from the first into the second.
      If boolExists = False Then
            'Sheets("Data").Select
            'Windows("Test.xls").Activate
            'Sheets("Data").Select
            objWB1.Sheets(strSheetToCopy).Copy ,objWB2.Sheets(objWB2.Sheets.Count)
            MsgBox "The """ & strSheetToCopy & """ sheet was copied to" & VbCrLf & strBook2
      Else
            MsgBox "The """ & strSheetToCopy & """ sheet already exists in" & VbCrLf & strBook2 & VbCrLf & _
                  "Sheet has not been copied."
      End If
Else
      MsgBox "Cannot not find the """ & strSheetToCopy & """ sheet in" & VbCrLf & strBook1
End If
' Turn on screen updating so Excel returns to normal
objExcel.ScreenUpdating = True
' Turn on automatic calculations so Excel returns to normal
objExcel.Calculation = xlCalculationAutomatic
objWB1.Close True
objWB2.Close True
objExcel.Quit
'====================

Regards,

Rob.
0
 
athersaleemCommented:
Sub CopSheet()
    Sheets("Projects").Select
    Sheets("Projects").Copy Before:=Workbooks("BookB").Sheets(1)
End Sub
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now