PDA

View Full Version : Need your help!



tdmcfly
08-28-2014, 01:20 PM
Hi All,


Need your expertise.. (again) =))

This is what I'm trying to do.

- The script is in A.xlsm
- A.xlsm and B.xls are both open
- I want to write a script that will export sheet3 of B.xls (if there is one) to a new workbook, named B_v2.xls
- Path of B.xls is C:\AAA\BBB\CCC (if that's relevant)


This is what I have so far:


Sub Export_Sheet3()
Dim Filename As String
Set Filename = ActiveWorkbook.FullName
Dim wsSheet As Worksheet
On Error Resume Next
Set wsSheet = Sheets("Sheet3")
On Error GoTo 0
If Not wsSheet Is Nothing Then
Application.CutCopyMode = False
Sheets("Sheet3").Move
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Sheet1"
ChDir = DefPath
ActiveWorkbook.SaveAs Filename:= _
Replace(Filename, ".XLS", "_2.XLS"), FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub


Thanks in advance!

Bob Phillips
08-28-2014, 02:45 PM
Untested


Sub Export_Sheet3()
Dim source As Workbook
Dim wsSheet As Worksheet
Dim Filepath As String
Dim Filename As String

Set source = Workbooks("B.xls")
Filename = source.FullName
On Error Resume Next
Set wsSheet = source.Worksheets("Sheet3")
On Error GoTo 0
If Not wsSheet Is Nothing Then

wsSheet.Copy
ActiveWorkbook.Worksheets(1).Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=Filepath & Application.PathSeparator & Replace(Filename, ".XLS", "_2.XLS"), _
FileFormat:=xlExcel8, _
CreateBackup:=False

Application.DisplayAlerts = False
wsSheet.Delete
Application.DisplayAlerts = True
End If

Application.CutCopyMode = False
End Sub