Bei Import Werte aus Zellen kopieren nicht Formeln???

[Marcel1212]

Hallo zusammen,

leider konnte mir gestern keiner weiterhelfen, deshalb probier ichs heute nochmal. 
Also, ich hab hier ein Makro, mit dem Daten aus einer Excel Tabelle in eine andere importiert werden.
mein Problem ist,dass nicht der Wert sonder die Formel, die sich in den Zellen befindet kopiert wird.
Kann mir jemand sagen, wie ich mein Makro umschreiben muss, damit das klappt???

Mein Makro:

Sub Import_mit_Dialog()

Dim Quelle As Object, Ziel As Object
Dim Datei As String
On Error GoTo Fehler
Datei = Application.GetOpenFilename("Excel-Dateien(*.xls),*xls")

If Datei = "Falsch" Then
MsgBox "keine Datei ausgewählt", , "Abbruch"
Exit Sub
End If

'MsgBox "Ausgewählte Datei: " & Datei, , ""

Workbooks.Open Filename:=Datei


Set Ziel = ThisWorkbook.Worksheets(3)

Blatt = Ziel.Range("N2").Value


Set Quelle = ActiveWorkbook.Worksheets(Blatt) '<-- gewähltes Blatt wird definiert als Quelle, alles andere wie gehabt

 
Quelle.Range("B9:B19").Copy Ziel.Range("B6:B17")
Quelle.Range("B20:B28").Copy Ziel.Range("B19:B27")
Quelle.Range("B29:B43").Copy Ziel.Range("B29:B43")
Quelle.Range("B44:B51").Copy Ziel.Range("B45:B52")
Quelle.Range("B52:B61").Copy Ziel.Range("B54:B63")
Quelle.Range("B62:B65").Copy Ziel.Range("B65:B68")
Quelle.Range("G9:G19").Copy Ziel.Range("G6:G17")
Quelle.Range("G20:G28").Copy Ziel.Range("G19:G27")
Quelle.Range("G29:G43").Copy Ziel.Range("G29:G43")
Quelle.Range("G44:G51").Copy Ziel.Range("G45:G52")
Quelle.Range("G52:G61").Copy Ziel.Range("G54:G63")

Quelle.Range("D9:D19").Copy Ziel.Range("D6:D17")
Quelle.Range("D20:D28").Copy Ziel.Range("D19:D27")
Quelle.Range("D29:D43").Copy Ziel.Range("D29:D43")
Quelle.Range("D44:D51").Copy Ziel.Range("D45:D52")
Quelle.Range("D52:D61").Copy Ziel.Range("D54:D63")
Quelle.Range("D62:D65").Copy Ziel.Range("D65:D68")
Quelle.Range("I9:I19").Copy Ziel.Range("I6:I17")
Quelle.Range("I20:I28").Copy Ziel.Range("I19:I27")
Quelle.Range("I29:I43").Copy Ziel.Range("I29:I43")
Quelle.Range("I44:I51").Copy Ziel.Range("I45:I52")
Quelle.Range("I52:I61").Copy Ziel.Range("I54:I63")
Quelle.Range("G62:G65").Copy Ziel.Range("G65:G68")

Quelle.Range("A9:A19").Copy Ziel.Range("A6:A17")
Quelle.Range("A20:A28").Copy Ziel.Range("A19:A27")
Quelle.Range("A29:A43").Copy Ziel.Range("A29:A43")
Quelle.Range("A44:A51").Copy Ziel.Range("A45:A52")
Quelle.Range("A52:A61").Copy Ziel.Range("A54:A63")
Quelle.Range("A62:A65").Copy Ziel.Range("A65:A68")
Quelle.Range("E9:E19").Copy Ziel.Range("E6:E17")
Quelle.Range("E20:E28").Copy Ziel.Range("E19:E27")
Quelle.Range("E29:E43").Copy Ziel.Range("E29:E43")
Quelle.Range("E44:E51").Copy Ziel.Range("E45:E52")
Quelle.Range("E52:E61").Copy Ziel.Range("E54:E63")




ActiveWorkbook.Close

Set Quelle = Nothing
Set Ziel = Nothing

Exit Sub

Fehler:
Set Quelle = Nothing
Set Ziel = Nothing

MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
 , vbCritical, "Fehler"
 


End Sub

Danke!!

[Officer]

Hi Marcel,

ich habe den Code mal etwas modifiziert, so dass nur noch Werte übertragen werden.
Im Beispielcode habe ich die Übertragung von 3 Bereichen eingebaut. Die restlichen Bereiche musst du einfach nur wie die vorgegebenen drei Kopierbereiche in den Code einbauen.

Code: Visual Basic

1. Sub Import_mit_Dialog()
2.  
3. Dim Quelle As Object, Ziel As Object
4. Dim Datei As String
5. 'On Error GoTo Fehler
6. Datei = Application.GetOpenFilename("Excel-Dateien(*.xls),*xls,")
7.  
8. If Datei = "Falsch" Then
9. MsgBox "keine Datei ausgewählt", , "Abbruch"
10. Exit Sub
11. End If
12.  
13. 'MsgBox "Ausgewählte Datei: " & Datei, , ""
14.  
15. Workbooks.Open Filename:=Datei
16.  
17.  
18. Set Ziel = ThisWorkbook.Worksheets(3)
19. Set wbziel = ThisWorkbook
20.  
21. Blatt = Ziel.Range("N2").Value
22.  
23. Set Quelle = ActiveWorkbook.Worksheets(Blatt) '<-- gewähltes Blatt wird definiert als Quelle, alles andere wie gehabt
24. Set wbquell = ActiveWorkbook
25.  
26. wbziel.Activate
27.  
28. '** Ersten Bereich kopieren
29. Quelle.Range("B9:B19").Copy
30. Ziel.Range("B6:B17").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
31.   :=False, Transpose:=False
32.  
33. '** Zweiten Bereich kopieren
34. Quelle.Range("B20:B28").Copy
35. Ziel.Range("B19:B27").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
36.   :=False, Transpose:=False
37.  
38. '** Dritter Bereich kopieren
39. Quelle.Range("B29:B43").Copy
40. Ziel.Range("B29:B43").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
41.   :=False, Transpose:=False
42.  
43.  
44. ActiveWorkbook.Close
45.  
46. Set Quelle = Nothing
47. Set Ziel = Nothing
48.  
49. Exit Sub
50.  
51. Fehler:
52. Set Quelle = Nothing
53. Set Ziel = Nothing
54.  
55. MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
56. & "Beschreibung: " & Err.Description _
57.  , vbCritical, "Fehler"
58.  
59. End Sub
60.  

Gruß

Officer

[Marcel1212]

Super!Danke schön!
Du bist mal wieder meine Rettung