Code stopped working

[Damo10]

Hi,

I have been updating a workbook by adding some new sheets and some code that only works on these sheets but the existing code to import the data no longer works. I have tried this code on a new workbook and it works fine, the errors that I have got so far are a Compile error and run time erro 438. Can anyone tell me why this is doing this?

here is the import code from the existing workbook, it is currently stopping on the red text.

Sub Import()
Dim Finfo As String
Dim Title As String
Dim FileName As Variant
Dim CurrentFile As Variant
Dim CurrentFileName As String
Dim NewFileName As String
'Import 71mm
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Sheets("71mm").Select
    CurrentFileName = ActiveWorkbook.Name
    Title = "Select 71mm Profile"
    FileName = Application.GetOpenFilename(Finfo, FilterIndex, Title)
    If FileName = False Then
    MsgBox "No file was selected."
    Exit Sub
    End If
    Workbooks.Open FileName, ReadOnly:=1, UpdateLinks:=False
    NewFileName = ActiveWorkbook.Name
    Sheets("profiles").Select
    Range("a1:n1809").Select
    Selection.Copy
    Workbooks(CurrentFileName).Activate  'Go back to the original file
    Sheets("71mm").Select
    Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Paste the copied cells
    Range("a1").Select
    Workbooks(NewFileName).Activate 'Go back to the new file
    Application.CutCopyMode = False
    ActiveWorkbook.Close False 'close new file

 

[shg]

Maybe like this:

Sub Import()
    Dim wks         As Worksheet
    Dim sFile       As String
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Set wks = ActiveWorkbook.Worksheets("71mm")
    sFile = Application.GetOpenFilename(FilterIndex:="Excel files, *.xlsx; *.xlsm", _
                                        Title:="Select 71mm Profile")
    If sFile = "False" Then
        MsgBox "No file was selected."
    
    Else
        With Workbooks.Open(FileName:=sFile, ReadOnly:=True, UpdateLinks:=False)
            .Worksheets("Profiles").Range("A1:N1809").Copy
            wks.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Close SaveChanges:=False
        End With
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[nigelk]

I think you are overwriting your original selection that you want copied , "Range("a1:n1809").select"

with "Range("a1").Select.Selection.PasteSpecial"


Try it without selecting the sheet or range A1

    Workbooks(CurrentFileName).Activate  'Go back to the original file
    Sheets("71mm").Activate
    Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Paste the copied cells

 

[jbeaucaire]

Assuming the Finfo and the FilterIndex are variables provided with answers from elsewhere:

Sub Import()
Dim wbCurr  As Workbook
Dim wb71mm  As Workbook
Dim fName   As String

'Import 71mm
    Title = "Select 71mm Profile"
    Set wbCurr = ActiveWorkbook
    fName = Application.GetOpenFilename(Finfo, FilterIndex, Title)
    
    If FileName = False Then
        MsgBox "No file was selected."
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set wb71mm = Workbooks.Open(fName, ReadOnly:=1, UpdateLinks:=False)
    
    Sheets("profiles").Range("A1:N1809").Copy
    wbCurr.Sheets("71mm").Range("a1").PasteSpecial xlPasteValuesAndNumberFormats
    
    wb71mm.Close False 'close new file

    Application.ScreenUpdating = True
    Application.EnableEvents = True

The reason your code probably stopped working was you turned off EnableEvents, then later exited the sub without turning them back on.

 

[Damo10]

Hi,

Thanks for your replys, I have tried SHG's code and get an error shown below and from jbeaucaire code it does not select any file, the file window opens but says no file was selected.

Sub Import()
Dim wks As Worksheet
Dim sFile As String

Application.ScreenUpdating = False
Application.EnableEvents = False

Set wks = ActiveWorkbook.Worksheets("71mm")
sFile = Application.GetOpenFilename(FilterIndex:="Excel files, *.xlsx; *.xlsm", _
Title:="Select 71mm Profile")
If sFile = "False" Then
MsgBox "No file was selected."

Else
With Workbooks.Open(FileName:=sFile, ReadOnly:=True, UpdateLinks:=False)
.Worksheets("Profiles").Range("A1:N1809").Copy
wks.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Close SaveChanges:=False
End With
End If

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[shg]

My bad:

sFile = Application.GetOpenFilename([COLOR=red]FileFilter[/COLOR]:="Excel files, *.xlsx; *.xlsm", _
                                    Title:="Select 71mm Profile")

 

[Damo10]

Perfect thanks SHG

 

[shg]

Lucky guess. You're welcome.