Live-Forum - Die aktuellen Beiträge
Datum
Titel
15.10.2025 16:22:17
Datum ist nicht Datum :(
15.10.2025 15:02:20
Blockpfeile mit Makro gehen nicht mehr nach freigabe
15.10.2025 13:51:13
VBA - Fortschrittsbalken unabhängig von Zellen
15.10.2025 13:31:47
WENN Formel mit zwei Bedingungen über 4 Spalten...
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1244to1248
1244to1248
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zellen in andere Mappe kopieren per Button

Forumthread: Zellen in andere Mappe kopieren per Button

Zellen in andere Mappe kopieren per Button
Erik
Hallo zusammen,
ich würde gern über einen Button in eine anderen Excel-mappe ein paar Zellen hinein kopieren.
Hab hier schon was ausprobiert aber nach dem er die mappe öffnet passiert einfach nichts mehr. Er kopiert es nicht in die neu geöffnete Mappe.
Danke für Hilfe im voraus.
Hier mein Code bis jetzt:

Sub MappeOeffnen()
Dim strOrdner As String, strdateiname As String
Dim wbMappe As Workbook
strOrdner = "C:\Dein\Ordner\"
strdateiname = "Auswertung.xls"
On Error Resume Next
Set wbMappe = Workbooks(strdateiname)
If Not wbMappe Is Nothing Then
wbMappe.Activate
MsgBox "Mappe ist bereits geöffnet !"
Else
If Dir(strOrdner & strdateiname)  "" Then
Set wbMappe = Workbooks.Open(strOrdner & strdateiname, UpdateLinks:=False)
Else
MsgBox "Folgende Datei existiert nicht : " & vbf & vbLf & _
strOrdner & strdateiname, vbOKOnly + vbCritical, "Datei nicht gefunden !"
End If
End If
Set wbMappe = Nothing
--> Bis hier TOP !!! Aber Kopiervorgang klappt nicht.
Workbooks("MappeA.xls").Sheets("SheetA").Range("F10:H22").Copy
Workbooks("MappeB.xls").Sheets("SheetB").Range("C10").PasteSpecial xlPasteValues
End Sub

Anzeige
AW: Zellen in andere Mappe kopieren per Button
06.01.2012 14:24:55
Reinhard
Hallo Erik,
sind denn MappeA.xls und MappeB.xls geöffnet?
Existieren auf ihnen die Blätter SheetA bzw. SheetB?
Gruß
Reinhard
AW: Zellen in andere Mappe kopieren per Button
06.01.2012 14:27:24
selli
hallo erik,
wie lauten denn die namen deiner mappen?
oben im code heisst die zu öffnende "Auswerung.xls"
und unten heisst sie "MappeB.xls"
das solltest du anpassen.
gruß selli
Anzeige
AW: Zellen in andere Mappe kopieren per Button
06.01.2012 14:28:34
Josef

Hallo Erik,
wozu deklarierst du eine Objekt-Variable, weist ihr mit Set ein Objekt (Arbeitsmappe) zu und verwendest sie dann nicht?
Probiere es mal so.
Sub MappeOeffnen()
  Dim strOrdner As String, strdateiname As String
  Dim wbMappe As Workbook, bolWasOpen As Boolean
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  strOrdner = "C:\Dein\Ordner\"
  strdateiname = "Auswertung.xls"
  bolWasOpen = True
  
  On Error Resume Next
  Set wbMappe = Workbooks(strdateiname)
  On Error GoTo ErrExit
  If wbMappe Is Nothing Then
    bolWasOpen = False
    If Dir(strOrdner & strdateiname) <> "" Then
      Set wbMappe = Workbooks.Open(strOrdner & strdateiname, UpdateLinks:=False)
    Else
      MsgBox "Folgende Datei existiert nicht : " & vbLf & vbLf & _
        strOrdner & strdateiname, vbOKOnly + vbCritical, "Datei nicht gefunden !"
    End If
  End If
  
  If Not wbMappe Is Nothing Then
    ThisWorkbook.Sheets("SheetA").Range("F10:H22").Copy
    wbMappe.Sheets("SheetB").Range("C10").PasteSpecial xlPasteValues
    If Not bolWasOpen Then
      wbMappe.Close True
    End If
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "Sub 'MappeOeffnen'" & vbLf & String(40, "=") & vbLf & vbLf & _
        IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & "Fehlernummer:" & vbTab & _
        .Number & vbLf & vbLf & "Beschreibung:" & vbTab & .Description & vbLf, vbExclamation, "Fehler in Modul - Modul3"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
  End With
  
  Set wbMappe = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: Zellen in andere Mappe kopieren per Button
06.01.2012 14:47:58
Erik
Hey super danke Sepp es klappt.
Mein Code sieht jetzt so aus:
Sub LadeButton_Click()
Dim strOrdner As String, strdateiname As String
Dim wbMappe As Workbook
strOrdner = "C:\Dein\Ordner\"
strdateiname = "MappeB.xls"
On Error Resume Next
Set wbMappe = Workbooks(strdateiname)
If Not wbMappe Is Nothing Then
wbMappe.Activate
MsgBox "Mappe ist bereits geöffnet !"
Else
'Wenn Mappe noch nicht geöffnet ist
If Dir(strOrdner & strdateiname)  "" Then
Set wbMappe = Workbooks.Open(strOrdner & strdateiname, UpdateLinks:=False)
Else
MsgBox "Folgende Datei existiert nicht : " & vbf & vbLf & _
strOrdner & strdateiname, vbOKOnly + vbCritical, "Datei nicht gefunden !"
End If
End If
If Not wbMappe Is Nothing Then
ThisWorkbook.Sheets("SheetA").Range("A17:D17").Copy
wbMappe.Sheets("SheetB").Range("B20:E20").PasteSpecial xlPasteValues
End If
'Speicher für Objektvariable wieder freigeben :
Set wbMappe = Nothing
End Sub

So, jetzt wäre noch super wenn ich den Button betätige das er es jedes mal eine Zeile drunter einfügt, wie das letzte mal. Also so, das er vorher in MappeB schaut und dann es nicht (wie hier B20:E20) sondern in B21:E21 reinschreibt beim nächsten mal klicken.
Danke noch mal an euch, das ihr so schnell geantwortet habt.
Gruß Erik
Anzeige
AW: Zellen in andere Mappe kopieren per Button
06.01.2012 14:54:45
Josef

Hallo Erik,
gefällt dir meine Fehlerbehandlung nicht?
Sub MappeOeffnen()
  Dim strOrdner As String, strdateiname As String
  Dim wbMappe As Workbook, bolWasOpen As Boolean
  Dim lngNext As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  strOrdner = "C:\Dein\Ordner\"
  strdateiname = "Auswertung.xls"
  bolWasOpen = True
  
  On Error Resume Next
  Set wbMappe = Workbooks(strdateiname)
  On Error GoTo ErrExit
  If wbMappe Is Nothing Then
    bolWasOpen = False
    If Dir(strOrdner & strdateiname) <> "" Then
      Set wbMappe = Workbooks.Open(strOrdner & strdateiname, UpdateLinks:=False)
    Else
      MsgBox "Folgende Datei existiert nicht : " & vbLf & vbLf & _
        strOrdner & strdateiname, vbOKOnly + vbCritical, "Datei nicht gefunden !"
    End If
  End If
  
  If Not wbMappe Is Nothing Then
    With wbMappe.Sheets("SheetB")
      lngNext = Application.Max(10, .Cells(.Rows.Count, 3).End(xlUp).Row + 1)
      ThisWorkbook.Sheets("SheetA").Range("F10:H22").Copy
      .Cells(lngNext, 3).PasteSpecial xlPasteValues
    End With
    If Not bolWasOpen Then
      wbMappe.Close True
    End If
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "Sub 'MappeOeffnen'" & vbLf & String(40, "=") & vbLf & vbLf & _
        IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & "Fehlernummer:" & vbTab & _
        .Number & vbLf & vbLf & "Beschreibung:" & vbTab & .Description & vbLf, vbExclamation, "Fehler in Modul - Modul3"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
  End With
  
  Set wbMappe = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: Zellen in andere Mappe kopieren per Button
06.01.2012 15:02:53
Erik
Doch, danke für deine Mühe Sepp hat mir echt weiter geholfen aber mein code ist kürzer.
na ja, wenn du meinst! o.T.
06.01.2012 15:08:44
Josef
« Gruß Sepp »

Anzeige
@Sepp als Ausgleich
06.01.2012 15:19:00
Reinhard
Hallo Sepp,
danke sehr für die Fehlerroutine :-)
Dadurch fiel mir wieder "Erl" ein, womit ich früher nix anfangen konnte. Jetzt habe ich recherchiert,
fand Code von Nepu, ein Add-In das den Code nummeriert.
Erl bei nummeriertem Code funktioniert Klasse *begeistert bin*
Gruß
Reinhard
Anzeige
;
Anzeige
Anzeige

Infobox / Tutorial

Zellen in andere Mappe kopieren per Button

Schritt-für-Schritt-Anleitung

  1. Öffne den Visual Basic for Applications (VBA) Editor: Drücke ALT + F11, um den VBA-Editor zu öffnen.

  2. Füge ein neues Modul hinzu: Klicke im Menü auf Einfügen > Modul.

  3. Kopiere folgenden Code in das Modul:

Sub LadeButton_Click()
    Dim strOrdner As String, strdateiname As String
    Dim wbMappe As Workbook
    strOrdner = "C:\Dein\Ordner\"
    strdateiname = "MappeB.xls"

    On Error Resume Next
    Set wbMappe = Workbooks(strdateiname)

    If Not wbMappe Is Nothing Then
        wbMappe.Activate
        MsgBox "Mappe ist bereits geöffnet !"
    Else
        ' Wenn Mappe noch nicht geöffnet ist
        If Dir(strOrdner & strdateiname) <> "" Then
            Set wbMappe = Workbooks.Open(strOrdner & strdateiname, UpdateLinks:=False)
        Else
            MsgBox "Folgende Datei existiert nicht: " & vbCrLf & strOrdner & strdateiname, vbOKOnly + vbCritical, "Datei nicht gefunden!"
        End If
    End If

    If Not wbMappe Is Nothing Then
        ThisWorkbook.Sheets("SheetA").Range("A17:D17").Copy
        wbMappe.Sheets("SheetB").Range("B20:E20").PasteSpecial xlPasteValues
    End If

    ' Speicher für Objektvariable wieder freigeben
    Set wbMappe = Nothing
End Sub

  1. Ändere den Zielbereich: Um die Daten immer eine Zeile weiter unten einzufügen, kannst du den Code anpassen, um den nächsten leeren Bereich zu finden.

  2. Füge einen Button hinzu: Gehe zurück zu deinem Excel-Dokument, wähle Entwicklertools und füge einen Button hinzu. Weisen den Button der LadeButton_Click-Prozedur zu.

Häufige Fehler und Lösungen

  • Fehler: „Datei nicht gefunden“: Überprüfe, ob der Pfad (strOrdner) und der Dateiname (strdateiname) korrekt sind.

  • Kopiervorgang klappt nicht: Stelle sicher, dass die Quelldatei (MappeA.xls) und die Zieldatei (MappeB.xls) geöffnet sind. Achte darauf, dass die Blätter existieren.

  • Blätter existieren nicht: Überprüfe die Namen der Blätter in deinem Code und stelle sicher, dass diese mit den tatsächlichen Namen in deiner Excel-Datei übereinstimmen.

Alternative Methoden

Eine andere Möglichkeit, Daten zwischen Arbeitsmappen zu kopieren, ist die Verwendung von Power Query, um die Daten in eine neue Tabelle zu laden und sie dort zu verarbeiten. Diese Methode kann besonders nützlich sein, wenn Du regelmäßig Daten importierst und transformierst.

Praktische Beispiele

Hier ist ein Beispiel, wie Du den Code anpassen kannst, um den nächsten freien Bereich in SheetB zu finden:

Dim lngNext As Long
With wbMappe.Sheets("SheetB")
    lngNext = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
    ThisWorkbook.Sheets("SheetA").Range("A17:D17").Copy
    .Cells(lngNext, "B").PasteSpecial xlPasteValues
End With

Dieser Code sucht nach der letzten nicht-leeren Zeile in der Spalte B von SheetB und fügt die kopierten Werte in die nächste Zeile ein.

Tipps für Profis

  • Verwende Application.ScreenUpdating = False: Dies verbessert die Leistung, indem es das Neuladen des Bildschirms während des Codes deaktiviert.

  • Fehlerbehandlung implementieren: Stelle sicher, dass Du eine umfassende Fehlerbehandlung einfügst, um unerwartete Fehler während der Ausführung zu verhindern.

  • Makros sicher speichern: Wenn Du Makros verwendest, vergiss nicht, Deine Excel-Datei im .xlsm-Format zu speichern, um die Makros zu erhalten.

FAQ: Häufige Fragen

1. Wie kann ich mehrere Zellen auf einmal kopieren?
Du kannst den Bereich, den Du kopieren möchtest, anpassen, indem Du die Range wie folgt definierst: Range("A1:B10").

2. Wie kann ich sicherstellen, dass die Dateien geöffnet werden?
Verwende On Error Resume Next, um Fehler während des Öffnens der Datei zu ignorieren, und überprüfe danach, ob die Datei erfolgreich geöffnet wurde.

3. Funktioniert dieser Code in allen Excel-Versionen?
Ja, der Code sollte in den meisten modernen Excel-Versionen funktionieren, die VBA unterstützen. Achte darauf, dass Du die richtigen Referenzen für die Excel-Objektbibliothek hast.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige