ich möchte Daten aus einer geöffneten sheet in eine sheet in der Datei "Daten.xls" speichern,
dann eine neue sheet öffnen und die Daten in die gleiche sheet in der Datei "Daten.xls"
anhängen, so das Daten aus mehreren sheets nun in einer einzigen sind. Das Alles
automatisiert unter VBA.
Kann mir bitte jemand helfen?
MfG Witali
Private Sub CommandButton1_Click()
On Error GoTo ErrorHandler ' Fehlerbehandlung aktivieren.
Dim FehlerNummer
Dim KomNr
Dim pfadname As String
Dim ad As Object
'Set ad = CreateObject("excel.sheet.9")
KomNr = TextBox1.Text
komNranf = Mid(KomNr, 1, 8)
KomNrend = Mid(KomNr, 9, 2)
Komnrneu = komNranf + "." + KomNrend + "D"
With Worksheets(1)
Set objhyper = _
.Hyperlinks.Add(Anchor:=.Range("A10"), _
Address:="u:\daten\Daten.xls")
objhyper.CreateNewDocument _
Filename:="u:\daten\Daten.xls", _
EditNow:=False, Overwrite:=True
End With
pfadname = "u:\daten\Ordner1\" + Komnrneu
Workbooks.OpenText Filename:=pfadname, Tab:=True
ActiveWorkbook.Worksheets.Copy
'#### An dieser Stelle möchte ich die Daten aus der Zwischenablage
'#### in die Datei Daten.xls in sheet1 kopieren
Workbooks.Open Filename:="u:\daten\Daten.xls"
Worksheets("Sheet1").Activate
'#### bis hierher geht es noch
ActiveSheet.Paste Destination:=Worksheets("Sheet1")
Workbooks(Right(pfadname, 12)).Close SaveChanges:=False
'#### Hier möchte ich eine 2. Datei mit gleichen Namen, aber aus einem
'#### anderen Ordner öffnen und diese in die Datei Daten.xls in sheet1
'#### hinten anhängen, damit ich nur eine Datei habe
pfadname = "u:\daten\Ordner2\" + Komnrneu
Workbooks.OpenText Filename:=pfadname, Tab:=True
Workbooks.Open Filename:="u:\daten\Daten.xls"
ActiveWorkbook.Worksheets.Add
Workbooks(Right(pfadname, 12)).Close SaveChanges:=False
ErrorHandler: ' Fehlerbehandlungsroutine.
Select Case Err.Number ' Fehlernummer auswerten.
Case 55 ' Fehler "Datei bereits geöffnet".
Close #1 ' Geöffnete Datei schließen.
Case Else
If Err.Number <> 0 Then
Mldg = "Fehler # " & Str(Err.Number) & " wurde ausgelöst von " _
& Err.Source & Chr(13) & Err.Description
MsgBox Mldg, , "Fehler", Err.HelpFile, Err.HelpContext
Err.Clear
End If
' Andere Fälle hier bearbeiten...
End Select
Resume ' Ausführung in der Zeile
' fortsetzen, die den Fehler ausgelöst hat.
End Sub