"Næsten" automatisk import fra anden excel fil

Prøv denne her:

Sub OpenExcelCopyFromFile()

Dim ws As Workbook
Dim ws1 As Workbook
 
  Application.ScreenUpdating = False

Set ws = ActiveWorkbook

fileToOpen = Application _
    .GetOpenFilename("xls fil (*.xls), *.xls")
If fileToOpen <> False Then
    Set ws1 = Workbooks.Open(Filename:=fileToOpen)    'ændret
    End If

Range("A5").Copy
ws.Activate
    Range("C9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
   
ws1.Activate
Range("B7").Copy
ws.Activate
    Range("D11").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False

ws1.Close savechanges:=False

Application.ScreenUpdating = True

End Sub

> stewen

Det ser rigtigt ud! en enkelt detalje som jeg gerne vil undgå, er at der kommer en "run-time" fejl, hvis der trykkes "cancel" til Open File dialog boksen. hvordan kan jeg undgå det.
Du må også gerne ligge et svar!

Perfekt - har tilføjet en linie!

Sub OpenExcelCopyFromFile()

Dim ws As Workbook
Dim ws1 As Workbook
 
  Application.ScreenUpdating = False

Set ws = ActiveWorkbook

fileToOpen = Application _
    .GetOpenFilename("xls fil (*.xls), *.xls")
If fileToOpen <> False Then
    Set ws1 = Workbooks.Open(Filename:=fileToOpen)
Else: Exit Sub 'INDSAT NY LINIE HER
    End If

Range("A5").Copy
ws.Activate
    Range("C9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
   
ws1.Activate
Range("B7").Copy
ws.Activate
    Range("D11").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False

ws1.Close savechanges:=False

Application.ScreenUpdating = True

End Sub

Et lille tillægsspørgsmål (håber det er OK) hvis nu data fra det ark jeg henter, IKKE ligger på "ark1" hvad kalder jeg så referencen?

Helt ok!

Sub OpenExcelCopyFromFile()

Dim ws As Workbook
Dim ws1 As Workbook
 
  Application.ScreenUpdating = False

Set ws = ActiveWorkbook

fileToOpen = Application _
    .GetOpenFilename("xls fil (*.xls), *.xls")
If fileToOpen <> False Then
    Set ws1 = Workbooks.Open(Filename:=fileToOpen)
Else: Exit Sub 'INDSAT NY LINIE HER
    End If
Sheets("DITARKNAVN").select
Range("A5").Copy
ws.Activate
    Range("C9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
   
ws1.Activate
Range("B7").Copy
ws.Activate
    Range("D11").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False

ws1.Close savechanges:=False

Application.ScreenUpdating = True

End Sub

Mange tak for hjælpen!