Tabellenblätter kopieren

Forumthread: Tabellenblätter kopieren

30.12.2015 08:00:50

Sigi

Hallo,
ich möchte gerne Tabellenblätter asu einer anderen Datei in die aktuelle Arbeitsmappe
kopieren.
Bei meinem Code stürzt Excel jedoch ab, bzw. die Datei wird zwar geöffnet und die Tabellenblätter eingefügt, jedoch nicht wieder geschlossen. Schliesse ich die Datei
dann kommt der Absturz.
Danke!
Gruß
Sigi

Sub Blaetter_einfügen()
Dim sPath as String, sFile as String
Dim Wkb as Object
sPath = ThisWorkbook.Path
sFile = "Aufgabe.xlsm"
Set Wkb = Workbooks.Open(sPath & sFile, False)
'  Wkb.Worksheets(Array("Auf_Pr", "Auf_Zu", "Auf_Data")).Select
With ThisWorkbook
Wkb.Worksheets(Array("Auf_Pr", "Auf_Zu", "Auf_Data")).Copy After:=.Worksheets(.Worksheets. _
Count)
End With
Wkb.Close savechanges:=False
End Sub

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabellenblätter kopieren

30.12.2015 09:34:59

Sepp
AW: Danke Sepp klappt super o.T.

30.12.2015 14:11:06

Sigi

AW: Tabellenblätter kopieren

30.12.2015 09:34:59

Sepp

Hallo Sigi,
ein \ fehlt bei sPath, ansonsten würd ich es so machen.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Blaetter_einfügen()
Dim sPath As String, sFile As String
Dim Wkb As Object
Dim CalculationMode As Long, UpdateLinks As Long

On Error GoTo ErrorHandler

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  CalculationMode = .Calculation
  .Calculation = xlManual
  UpdateLinks = .AskToUpdateLinks
  .AskToUpdateLinks = False
  .DisplayAlerts = False
End With

sPath = ThisWorkbook.Path

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

sFile = "Aufgabe.xlsm"

If Dir(sPath & sFile, vbNormal) <> "" Then
  Set Wkb = Workbooks.Open(sPath & sFile, False)
  
  With ThisWorkbook
    Wkb.Worksheets(Array("Auf_Pr", "Auf_Zu", "Auf_Data")).Copy _
      After:=.Worksheets(.Worksheets.Count)
  End With
  
  Wkb.Close False
End If

ErrorHandler:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'Blaetter_einfügen'" & vbLf & String(25, "") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, 81968, "VBA - Fehler in Prozedur - Blaetter_einfügen", .HelpFile, .HelpContext
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = CalculationMode
  .DisplayAlerts = True
  .AskToUpdateLinks = UpdateLinks
  .CutCopyMode = False
  .StatusBar = False
End With

Set Wkb = Nothing
End Sub

Gruß Sepp

AW: Danke Sepp klappt super o.T.

30.12.2015 14:11:06

Sigi

Beliebteste Forumthreads (12 Monate)

Forumthread: Tabellenblätter kopieren

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread