VBA openCopyandClose

[Donai]

Hi, found the below code which is almost what i am after. I need the code to be flexible where the code will allow me to choose the file and when i choose look for sheet "Current", if found then Copy A1:D to Thisworkbook sheet("Test").Range("A1") Else Exit Sub

Sub OpenCopyAndClose()
 Dim excelFile As String

 excelFile = "myfile.xls"

  'open excel file "myfile.xls" in drive D:\
  Workbooks.Open "D:\" & excelFile

  'copy value of range A1 from "myfile.xls"
  ThisWorkbook.Sheets(1).Range("D1").Value = _
    Workbooks(excelFile).Sheets(1).Range("A1").Value

  'close "myfile.xls" file and don't save any changes
  Workbooks(excelFile).Close SaveChanges:=False
End Sub

</pre>

 

[njimack]

The below (untested) code should work:

Sub OpenCopyAndClose()
Dim excelFile As String

excelFile = "myfile.xls"

'open excel file "myfile.xls" in drive D:\
Workbooks.Open "D:\" & excelFile

'copy value of range A1 from "myfile.xls"
If Len(Sheets("Current").Name) > 0 Then ThisWorkbook.Sheets(1).Range("D1").Value = _
Workbooks(excelFile).Sheets(1).Range("A1").Value
'close "myfile.xls" file and don't save any changes
Workbooks(excelFile).Close SaveChanges:=False
End Sub

 

[Donai]

But i dont want to hardcode the file name as this changes everymonth

excelFile = "myfile.xls"

 

[Ruddles]

This will allow you to select an Excel file and store its name in your existing variable excelFile:-

  excelFile = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*")
  If excelFile = "False" Then Exit Sub

If you want the dialog box to start in a specific place, change the drive and/or directory first. For example:-

  ChDrive Left(ThisWorkbook.Path, 2)
  ChDir Mid(ThisWorkbook.Path & "\", 3)

 

[njimack]

But i dont want to hardcode the file name as this changes everymonth

excelFile = "myfile.xls"

That wasn't clear from your post. Is there a rule to determine the sheet name?

 

[Donai]

So you saying something like this? Cos when i run the code i get an error on the copy part of the code

Sub OpenCopyAndClose()
 Dim excelFile As String

  excelFile = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*")
  If excelFile = "False" Then Exit Sub

  'copy value of range A1 from "myfile.xls"
  ThisWorkbook.Sheets("Test").Range("A6").Value = _
    Workbooks(excelFile).Sheets("Current").Range("B6:D1000").Value

  'close "myfile.xls" file and don't save any changes
  Workbooks(excelFile).Close SaveChanges:=False
End Sub

 

[Donai]

That wasn't clear from your post. Is there a rule to determine the sheet name?

Look for sheet"Current" in the Source workbook

 

[njimack]

And what's the rule to determine the filename?

 

[Donai]

And what's the rule to determine the filename?

There is no rule to determine file name, the code should allow to choose any file, if "Current sheet found then copy data

 

[ZVI]

Hi Donai,
Try:

Sub OpenCopyAndClose1()
  
  '--> Settings, change to suit
  Const SourceSheet$ = "Current"  ' Source sheet name
  Const SourceRange$ = "B6:D6"    ' 1st row of the source data
  Const DestSheet$ = "Test"       ' Destination sheet name
  Const DestRange$ = "A6"         ' 1st cell of the destination sheet
  ' <-- End of settings
  
  Dim Rng As Range
  
  ' Load source workbook via dialog
  With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = ThisWorkbook.Path
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel workbooks (*.xl*)", "*.xl*"
    On Error Resume Next
    If .Show Then .Execute Else Exit Sub
    If Err Then MsgBox "Canceled": Exit Sub
  End With
  
  ' Copy & paste data
  On Error GoTo exit_
  Application.ScreenUpdating = False
  With ActiveWorkbook
    ' Copy source data
    With .Sheets(SourceSheet)
      Set Rng = .Range(SourceRange).Resize(.UsedRange.Rows.Count)
    End With
    Rng.Copy
    ' Paste data to the destination
    With ThisWorkbook.Sheets(DestSheet)
      .Range(DestRange).Resize(Rng.Rows.Count, Rng.Columns.Count).PasteSpecial xlPasteValuesAndNumberFormats
    End With
    Application.CutCopyMode = False
    ' Close source workbook
    .Close False
  End With
  
exit_:
  Application.ScreenUpdating = True
  If Err Then MsgBox Err.Description Else MsgBox "Well done"
  
End Sub