Gruppe
Allgemein
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?
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