Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Blattinhalt von einer zur anderen Arbeitsmappe kopieren

Gruppe

Interaktion

Problem

Wie kann ich den Inhalt eines Arbeitsblattes der einen Arbeitsmappe in ein Blatt einer zweiten Mappe so kopieren, daß das Programm von sich aus erkennt, wo die Daten zugefügt werden sollen?

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: basMain

Sub OpenTest()
   Dim sPath As String
   sPath = ThisWorkbook.Path & "\"
   If Dir(sPath & "Test1.xls") = "" Or _
      Dir(sPath & "Test2.xls") = "" Then
      Beep
      MsgBox _
         prompt:="Testarbeitsmappen wurden nicht gefunden!"
      Exit Sub
   End If
   Application.ScreenUpdating = False
   Workbooks.Open sPath & "Test2.xls"
   Workbooks.Open sPath & "Test3.xls"
   ThisWorkbook.Activate
   Worksheets("Tabelle1").Select
   MsgBox "Die Testarbeitsmappen wurden geöffnet -" & vbLf & _
      "Sie können den Test durchführen!"
   Application.ScreenUpdating = True
End Sub

Sub Kombinieren()
   Dim wksSource As Worksheet, wksTarget As Worksheet
   Dim iRow As Integer
   Dim sWkb As String
   Call TestWkb("Test2.xls")
   Call TestWkb("Test3.xls")
   Set wksSource = Workbooks("Test2.xls").Worksheets(1)
   Set wksTarget = Workbooks("Test3.xls").Worksheets(1)
   iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 2
   wksTarget.Cells(iRow, 1).Value = "Daten aus Test1.xls:"
   wksSource.UsedRange.Copy wksTarget.Cells(iRow + 2, 1)
   Application.CutCopyMode = False
   Workbooks("Test3.xls").Activate
   MsgBox "Daten wurden eingefügt!"
End Sub

Private Sub TestWkb(sWkb As String)
   Dim wkb As Workbook
   On Error Resume Next
   Set wkb = Workbooks(sWkb)
   If Err > 0 Or wkb Is Nothing Then
      Beep
      MsgBox "Die Testarbeitsmappe " & sWkb & " ist nicht geöffnet!"
      End
   End If
   On Error GoTo 0
End Sub