Need help with Workbooks.Open Filename 1

[Stev1parr]

I want to copy from one xls and paste to another xls to another. To get there, I need to identify the two files and sheets. How do I identify the current xls that is open as well as indentfy the xls that I open to paste into? Additionally, how do I ensure the right sheets for both files are selected?

The Macro below allow for the openning of a second file which is great. But I need to establish the current open xls file and the correct sheet and the same for the second openned xls and sheet in the code.


Dim Filter As String, Title As String
Dim File As String
Dim FilterIndex As Integer
Dim Filename As Variant
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
"Text Files (*.txt),*.txt," & _
"All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path
ChDrive ("c")

With Application
' Set File Name to selected File
Filename = .GetOpenFilename(Filter, FilterIndex, Title)
' Reset Start Drive/Path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
' Open File
Workbooks.Open Filename

 

[PHV]

A starting point:

...
Dim curWB As Workbook, destWB As Workbook
Set curWB = ActiveWorkbook
' Open File
Set destWB = Workbooks.Open(Filename)
curWB.Worksheets("Sheet1").Range("A1:D4").Copy _
    destination:=destWB.Worksheets("Sheet2").Range("E5")
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Stev1parr]

Thank you very much. It Worked!!!

 

[Stev1parr]

I want to validate that "destination:=destWB.Worksheets("Sheet2").Range("E5")" is the correct worksheet.

How do I write an if statement to alert that the active workbook.worksheets does not match the destination.
________________________
Below is my attempt:

If Destination = False Then
MsgBox "Work Sheets do not Match."
Exit Sub
Else
End If
CurWB.Worksheets("Resource Sheet").Range("E4:I69").Copy _
Destination = destWB.Worksheets("Resource Sheet").Range("E4:I69")
_________________________

In testing, both worksheets match. However, my code producesa "false" thus trickering the Msg.

Any suggestion?

 

[SkipVought]

If destWB.Worksheets("Sheet2") is nothing then
  msgbox "Sheet2 does not exist"
else
  'do something with sheet2
end with

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Stev1parr]

Tried the code below:

If destWB.Worksheets("Sheet2") is nothing then msgbox "Sheet2 does not exist"else 'do something with sheet2
end with
______________________

Received a "Subscript out of range" error message. Below is how I am using the If statement:

Private Sub CommandButton119_Click()
Dim Filter As String, Title As String
Dim File As String
Dim FilterIndex As Integer
Dim Filename As Variant
Dim curWB As Workbook, destWB As Workbook

Set curWB = ActiveWorkbook

' File filters
Filter = "Excel Files (*.xls),*.xls," & _
"Text Files (*.txt),*.txt," & _
"All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path
ChDrive ("")

With Application
' Set File Name to selected File
Filename = .GetOpenFilename(Filter, FilterIndex, Title)
' Reset Start Drive/Path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
' Open File
Workbooks.Open Filename

Set destWB = Workbooks.Open(Filename)

'!!!!!!Start Data Transfer!!!!!!!

' Exit on Cancel
If destWB.Worksheets("Resource Sheet") Is Nothing Then
MsgBox "Resource Sheet does not exist"
Else
End If

'Item Cost
curWB.Worksheets("Resource Sheet").Range("E4:I69").Copy _
Destination:=destWB.Worksheets("Resource Sheet").Range("E4:I69")

 

[SkipVought]

Here's what I would do...

dim ws as worksheet, bFound as boolean
Set destWB = Workbooks.Open(Filename)

bFound = false
for each ws in destWB.worksheets
  if ws.name = "Sheet2" then 
    bfound = true
    exit for
  end if
next

If bfound Then  
  curWB.Worksheets("Resource Sheet").Range("E4:I69").Copy _        Destination:=destWB.Worksheets("Resource Sheet").Range("E4:I69")
Else
  msgbox "no sheet"
End If

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Stev1parr]

That did the trick. Thank so much.

 

[Stev1parr]

I am at the end of a great code the copies from one file to another. I thought I had everthing done until I saw the need for greater buy in from users. Below is a much shorter version of what I want to do. Everything works until I get to the PasteSpecial line. The curWB has the formula in cell. I want just the value pasted to destWB. When I get to the PasteSpecial line of code, error. Any suggestion on where I am going wrong on this line of code? See below.

Private Sub CommandButton119_Click()
Dim Filter As String, Title As String
Dim File As String
Dim FilterIndex As Integer
Dim Filename As Variant
Dim curWB As Workbook, destWB As Workbook
Dim ws As Worksheet, bFound As Boolean

Set curWB = ActiveWorkbook
With Application
'Set Password
PWORD = "1111"
End With

'Unprotect active sheet with password.
Unprotect PWORD

' File filters
Filter = "Excel Files (*.xls),*.xls," & _
"Text Files (*.txt),*.txt," & _
"All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path
ChDrive ("")

With Application
' Set File Name to selected File
Filename = .GetOpenFilename(Filter, FilterIndex, Title)
' Reset Start Drive/Path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
' Open File

Workbooks.Open Filename
Application.StatusBar = "Please wait while application completes the data transfer. This will take less than 45 seconds."


Application.ScreenUpdating = False


'!!!!!!Start Data Transfer!!!!!!!
Set destWB = Workbooks.Open(Filename)
'Unprotect active sheet with password.

ActiveSheet.Unprotect ("1111")
' Exit on Cancel
bFound = False
For Each ws In destWB.Worksheets
If ws.Name = "Resource Sheet" Then
bFound = True
Exit For
End If
Next

If bFound Then
'Item and Cost
curWB.Worksheets("Resource Sheet").Range("E4:I69").Copy _
Destination:=destWB.Worksheets("Resource Sheet").Range("E4:I69")
Else
MsgBox "Resource Sheet does not exist"
Exit Sub
End If

'Item Weights
curWB.Worksheets("Resource Sheet").Range("M469").Copy _
Destination:=destWB.Worksheets("Resource Sheet").Range("M469")
'Distribution Points
curWB.Worksheets("Resource Sheet").Range("U3:V62").Copy _
Destination:=destWB.Worksheets("Resource Sheet").Range("U3:V62")
'DB1
curWB.Worksheets("Week 5").Unprotect ("1111")
curWB.Worksheets("Week 5").Range("d78:d143").Copy _
Destination:=destWB.Worksheets("Resource Sheet").Range("y3:Y68").PasteSpecial(xlPasteValues)




'Procect with password.
ActiveSheet.Protect Password:=("1111"), _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True

curWB.Worksheets("Resource Sheet").Protect ("1111")
curWB.Worksheets("Week 5").Protect ("1111")
Application.ScreenUpdating = True
Application.StatusBar = False
'!!!!!!!!!!!!!!!!!Data Transfer Complete!!!!!!!!!!!!!!!!!
MsgBox "Data Transfer Complete. New Textile Management Tool is ready for use. Save before closing this file."

End Sub
__________________
Additionally, for any other file open errors, I could use a If statement that identifies if file destWB is already open. If so, "text" alerting to this fact and move one. Currently, Excel its own alert, if selecting the "no", causes a error.

 

[PHV]

Replace this:
curWB.Worksheets("Week 5").Range("d78:d143").Copy _
Destination:=destWB.Worksheets("Resource Sheet").Range("y3:Y68").PasteSpecial(xlPasteValues)
with this:
curWB.Worksheets("Week 5").Range("d78:d143").Copy
destWB.Worksheets("Resource Sheet").Range("y3:Y68").PasteSpecial xlPasteValues

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Stev1parr]

When I modify the PasteSpeacial and run the code, I get the follwoing error message "Object doesen't support this property or method".

 

[Stev1parr]

When I modify the PasteSpeacial and run the code,

From:
Destination:= destWB.Worksheets("Resource Sheet").Range("y3:Y68").PasteSpecial xlPasteValues

To:
destWB.Worksheets("Resource Sheet").Range("y3:Y68").PasteSpecial xlPasteValues

I get the follwoing error message "Object doesen't support this property or method".

What am I doing wrong?

 

[PHV]

Did you remove the _ at the end of the previous line ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Stev1parr]

The code now works after removing the "_".

I could use a If statement that identifies if file destWB is already open. If so, "text" alerting to this fact and move one. Currently, Excel its own alert, if selecting the "no", causes a error. Can any assistnce be provided with this?