Tabelleneinträge in andere Mappe dranhängen

Hallo, guten Abend!
Ich habe ein Problem, wer kann helfen?
Mit dem Code hole-kopiere ich einen Bereich von Mappe Monteur.xls nach Mappe Büro.xls. Wie könnte ich da nur den benutzten Bereich wählen zum kopieren?
Wie könnte ich das ändern dass die Einträge der Mappe Monteur.xls Tabelle (Testdaten) immer in die nächste freie Zeile in Mappe Büro.xls(Tabelle4) "angehängt" wird.
Mit dem Code unten wird im Moment alles überschrieben was schon drinsteht.
Soll aber Endlos angehängt werden-wöchentlich kommen neue Daten zur Mappe Büro.xls hinzu.


Private Sub CommandButton5_Click()
Dim Dateiname As String
Dim wsp As Worksheet
Set wsp = ThisWorkbook.Worksheets("Tabelle4")
Application.CutCopyMode = False
Const Pfd = "Z:\Personal\Eigene\Egon\AJD\"
Const Datei = "Monteur.xls"
Dateiname = Pfd & Datei
Application.DisplayAlerts = False
Workbooks.Open Dateiname, , , , "moi"
Workbooks("Monteur.xls").Worksheets("Testdaten").Range("B2:H80").Copy
With wsp.Range("A3")
.PasteSpecial Paste:=xlValues                  ' Werte
.PasteSpecial Paste:=xlFormats                ' Formate
End With
Workbooks("Monteur.xls").Close
wsp.Activate
End Sub

Vielen Dank im Voraus
Egon

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Egon!
Ungetestet!

Private Sub CommandButton5_Click()
Dim Dateiname As String
Dim wsp As Worksheet
Dim lngLast As Long

Const Pfd = "Z:\Personal\Eigene\Egon\AJD\"
Const Datei = "Monteur.xls"

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
  .Cursor = xlWait
End With

Set wsp = ThisWorkbook.Worksheets("Tabelle4")

lngLast = wsp.Cells(Rows.Count, 1).End(xlUp).Row + 1

Dateiname = Pfd & Datei

Workbooks.Open Dateiname, , , , "moi"
Workbooks("Monteur.xls").Worksheets("Testdaten").Range("B2:H80").Copy

With wsp.Cells(lngLast, 1)
  .PasteSpecial Paste:=xlValues ' Werte
  .PasteSpecial Paste:=xlFormats ' Formate
End With

Workbooks("Monteur.xls").Close , False

Set wsp = Nothing

On Error GoTo 0

ErrExit:

If Err.Number > 0 Then
  MsgBox "Fehler:" & vbTab & Err.Number & " (" & Err.Description & ")" & _
    Space(15), vbExclamation, "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
  .Cursor = xlDefault
End With

End Sub

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Beliebteste Forumthreads (12 Monate)

Tabelleneinträge in andere Mappe dranhängen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabelleneinträge in andere Mappe dranhängen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread