Office: (Office 365) Mehrere Zellen aus geschlossener Datei kopieren

Hallo,
ich versuche aus einer geschlossene .xls Datei 7 Zellen zu aktive Mappe zu kopieren.
Das Klappt aber nicht mit folgenden Code.

Sub aa()

Dim Rechnung As String
Dim Datum As String
Dim Kunde As String
Dim Bauvorhaben As String
Dim Auftrag As String
Dim Tour As String
Dim Betrag As String

DatName = Application.GetOpenFilename '(".xls")
Rechnung = Range("I19")
Datum = Range("I20")
Kunde = Range("A12")
Bauvorhaben = Range("D25")
Auftrag = Range("D21")
Tour = Range("D22")
Betrag = Range("I61")

Worksheets("Tabelle1").Select
Worksheets("Tabelle1").Range("A1").Select
If Worksheets("Tabelle1").Range("A1").Offset(1, 0) <> "" Then
Worksheets("Tabelle1").Range("A1").End(xlDown).Select
End If

ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Rechnung
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Datum
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Kunde
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Bauvorhaben
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Auftrag
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Tour
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Betrag

End Sub


Was mache ich falsch?

Vielen Dank schon einmal für Eure Hilfe!

Gruß
Amar

 

Hallo

Frage:
Dreht es sich immer um die gleichen Zeilen aus ein und der selben Datei?
Was geschieht weiter den Daten?
Wenn ja, darf es auch ohne VBA sein mit Power Query Lösung sein?
Viele Grüße

 

Hallo,
es handelt sich immer um die gleiche Zellen.
Die Zellen sollen von Rechnung kopiert werden.
Es handelt sich um Dateien wo mehrere Zugriff haben.
Auf die Rechnungsliste habe ich alleinigen Zugriff.
Deswegen wollte ich den Code in der Rechnungsliste speichern und nicht verknüpfen.
Viele Grüße

 

Hi,

versuche es mal so (ungetestet):

Code:

Sub aa()
    Dim Rechnung As String
    Dim Datum As String
    Dim Kunde As String
    Dim Bauvorhaben As String
    Dim Auftrag As String
    Dim Tour As String
    Dim Betrag As String
    Dim lngErste As Long
    Dim DatName As String
 
    DatName = Application.GetOpenFilename '(".xls")
    If DatName = "Falsch" Or DatName = False Then Exit Sub
 
    ' geöffnete und damit aktive Quell-Arbeitsmappe
    With ActiveWorkbook.Worksheets("Tabelle1") '<== Name der Quelltabelle anpassen!!
        Rechnung = .Range("I19")
        Datum = .Range("I20")
        Kunde = .Range("A12")
        Bauvorhaben = .Range("D25")
        Auftrag = .Range("D21")
        Tour = .Range("D22")
        Betrag = .Range("I61")
    End With
 
    ' Ziel-Arbeitsmappe (Arbeitsmappe mit dem Code)
    With ThisWorkbook.Worksheets("Tabelle1")
        If Worksheets("Tabelle1").Range("A1").Offset(1, 0) <> "" Then
            lngErste = .Range("A1").End(xlDown).Row + 1
            .Cells(lngErste, 1).Rechnung
            .Cells(lngErste, 2) = Datum
            .Cells(lngErste, 3) = Kunde
            .Cells(lngErste, 4) = Bauvorhaben
            .Cells(lngErste, 5) = Auftrag
            .Cells(lngErste, 6) = Tour
            .Cells(lngErste, 7) = Betrag
        End If
    End With
End Sub

Man sollte immer korrekte Bezüge auf Arbeitsmappen/Tabellenblätter/Zellen u.a. Objekte verwenden, wenn man mit mehreren Arbeitsmappen arbeitet - das realisiert man durch With-Anweisungen. Beachte, dass dabei die Bezüge immer durch einen vorangesetzten Punkt (.) signalisiert werden. Dadurch wird verhindert, dass falsche Objekte (Arbeitsmappen, Tabellenblätter, Zellen usw.) angesprochen werden.

---

 

Hallo Beverly,
habe es getestet.
Es kommt leider ein Laufzeitfehler '13' bei: If DatName = "Falsch" Or DatName = False Then Exit Sub

Gruss
Amar

 

Habe noch folgende Änderung probiert.

If DateiName = "Falsch" Or DateiName = False Then Exit Sub

Es kommt dann kein Fehlermeldung mehr,
aber es wird nichts rüber kopiert.

 

Hi,

ändere den Code wie folgt:

Code:

Sub aa()
    Dim Rechnung As String
    Dim Datum As String
    Dim Kunde As String
    Dim Bauvorhaben As String
    Dim Auftrag As String
    Dim Tour As String
    Dim Betrag As String
    Dim lngErste As Long
    Dim DatName As Variant
   
    DatName = Application.GetOpenFilename '(".xls")
    If DatName = "Falsch" Or DatName = False Then Exit Sub
   
    ' Arbeitsmappe öffnen
    Workbooks.Open DatName
    ' Quell-Arbeitsmappe
    With ActiveWorkbook.Worksheets("Tabelle1") '<== Name der Quelltabelle anpassen!!
        Rechnung = .Range("I19")
        Datum = .Range("I20")
        Kunde = .Range("A12")
        Bauvorhaben = .Range("D25")
        Auftrag = .Range("D21")
        Tour = .Range("D22")
        Betrag = .Range("I61")
    End With
   
    ' Ziel-Arbeitsmappe
    With ThisWorkbook.Worksheets("Tabelle1")
        If Worksheets("Tabelle1").Range("A1").Offset(1, 0) <> "" Then
            lngErste = .Range("A1").End(xlDown).Row + 1
            .Cells(lngErste, 1).Rechnung
            .Cells(lngErste, 2) = Datum
            .Cells(lngErste, 3) = Kunde
            .Cells(lngErste, 4) = Bauvorhaben
            .Cells(lngErste, 5) = Auftrag
            .Cells(lngErste, 6) = Tour
            .Cells(lngErste, 7) = Betrag
        End If
    End With
    ' Arbeitsmappe wieder schließen
    ActiveWorkbook.Close False
End Sub

Noch einen Hinweis: in deinem Eröffnungsbeitrag hattest du geschrieben:

Das ist eine Aussage, die absolut nicht hilfreich ist - richtiger ist es genau zu beschrieben, WAS nicht klappt. Das Hauptproblem deines Code ist nämlich, dass er überhaupt keine andere Arbeitsmappe öffnet, denn um etwas kopieren zu können muss die Arbeitsmappe erst geöffnet (und am Ende wieder geschlossen) werden - beides habe ich im Code ergänzt.

---

 

Hi,
ich habe den Code jetzt geändert
Es wird keine Fehlermeldung mehr angezeigt.
Beim Code Ausführen lässt die Datei zum öffnen auswählen.
Nach der Datei Auswahl öffnet sich kurz ein Fenster und schließt sich wieder.
Es wird aber nichts in der Rechnungsliste kopiert.

Ich lade die Dateien mit hoch.
Vielleicht liegt es ja an den Dateien.

Gruss
Amar

 

Hi,

dein Code für die erste freie Zeile ermittelt einen falschen Wert - ändere sie wie folgt:

Code:

            lngErste = .Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

Damit sollte der Code jetzt korrekt funktionieren.

---

 

Hi,

die Inhalte der Zellen werden nicht rüber kopiert.
Habe ich das richtig geändert?


Sub aa()
Dim Rechnung As String
Dim Datum As String
Dim Kunde As String
Dim Bauvorhaben As String
Dim Auftrag As String
Dim Tour As String
Dim Betrag As String
Dim lngErste As Long
Dim DatName As Variant

DatName = Application.GetOpenFilename '(".xls")
If DatName = "Falsch" Or DatName = False Then Exit Sub

' Arbeitsmappe öffnen
Workbooks.Open DatName
' Quell-Arbeitsmappe
With ActiveWorkbook.Worksheets("Tabelle1") '<== Name der Quelltabelle anpassen!!
Rechnung = .Range("I19")
Datum = .Range("I20")
Kunde = .Range("A12")
Bauvorhaben = .Range("D25")
Auftrag = .Range("D21")
Tour = .Range("D22")
Betrag = .Range("I61")
End With

' Ziel-Arbeitsmappe
With ThisWorkbook.Worksheets("Tabelle1")
If Worksheets("Tabelle1").Range("A1").Offset(1, 0) <> "" Then
lngErste = .Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
.Cells(lngErste, 1).Rechnung
.Cells(lngErste, 2) = Datum
.Cells(lngErste, 3) = Kunde
.Cells(lngErste, 4) = Bauvorhaben
.Cells(lngErste, 5) = Auftrag
.Cells(lngErste, 6) = Tour
.Cells(lngErste, 7) = Betrag
End If
End With
' Arbeitsmappe wieder schließen
ActiveWorkbook.Close False
End Sub

 

Hi,

Code:

    ' Ziel-Arbeitsmappe
    With ThisWorkbook.Worksheets("Tabelle1")
        If .Range("A1") <> "" Then
            lngErste = .Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            .Cells(lngErste, 1) = Rechnung
            .Cells(lngErste, 2) = Datum
            .Cells(lngErste, 3) = Kunde
            .Cells(lngErste, 4) = Bauvorhaben
            .Cells(lngErste, 5) = Auftrag
            .Cells(lngErste, 6) = Tour
            .Cells(lngErste, 7) = Betrag
        End If
    End With

---

 

Hi,

es geht jetzt. (Perfekt)
Vielen vielen Dank!

Habe noch ein kleines Problem mit der Kopierten Zell ("I61") mit hinterlegte Formel =(I57-I58)+I59.
Der wert wird nicht richtig übernommen.
Gibt es dafür eine Lösung?

Gruss
Amar

 

Hi,

inwiefern wird der Wert nicht richtig übernommen? In I61 steht das Formelergebnis 640,25 € und in der Zielzelle wird 640,25 € als fester Wert ausgegeben - also alles völlig korrekt.

---

 

Hi,

es wir d der Wert 640,25 geschrieben statt 640,25 €.
Bei anderen Rechnung wird der Wert 239.355,00 € geschrieben statt 239,36 €.


Gruss
Amar

 

Hi,

der Wert wird schon korrekt übernommen, nur das Format nicht - aber das liegt an deiner falschen Variablendeklaration: ein Euro-Wert darf nicht als String sondern sollte als Currency deklariert werden, oder als Double. Auch ein Datum darf nicht als String sondern muss als Date deklariert werden, oder als Long:

Code:

    Dim Rechnung As String
    Dim Datum As Date
    Dim Kunde As String
    Dim Bauvorhaben As String
    Dim Auftrag As String
    Dim Tour As String
    Dim Betrag As Currency
    Dim lngErste As Long
    Dim DatName As Variant

Werden Double bzw. Long verwendet, muss nachträglich das Zellformat in Währung bzw. Datum umgewandelt werden - deshalb ist es einfacher/simmvoller, gleich die richtige Deklaration zu verwenden.

---