Thema Datum  Von Nutzer Rating
Antwort
09.04.2014 09:44:20 cille40
NotSolved
09.04.2014 10:19:05 gabi
NotSolved
Rot Mehrere Tabellenblätter auswählen und in neue Mappe einfügen
11.04.2014 10:06:03 cille40
NotSolved

Ansicht des Beitrags:
Von:
cille40
Datum:
11.04.2014 10:06:03
Views:
2034
Rating: Antwort:
  Ja
Thema:
Mehrere Tabellenblätter auswählen und in neue Mappe einfügen

Hallo Gabi,

 

Vielen Dank für Deine Antwort!

 

Ich hab an dem Code mal etwas gefeilt und nun sieht er so aus:

Private Sub CmdSelect2_Click()
  
Dim intSh As Integer
Dim Msg As String
Dim wks As Worksheet
Dim strLC As String
Dim Rng As Range
Dim wb As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim i As Integer
Dim r As Object, LR As Long

Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set wks = Worksheets.Add
wks.Name = "Completed Checklist"
If Me.ListBox2.ListCount = 0 Then Exit Sub
For intSh = 0 To Me.ListBox2.ListCount - 1
  If Me.ListBox2.Selected(intSh) Then Msg = Msg & Me.ListBox2.List(intSh) & vbCr
Next
Unload Me
          
For i = 3 To wb.Worksheets.Count
  If InStr(Msg, wb.Sheets(i).Name) > 0 Then
    With wb.Sheets(i).UsedRange
      LR = wks.Cells(Rows.Count, "A").End(xlUp).Row + 1
      strLC = .Cells(.Rows.Count, .Columns.Count).Address
      Set Rng = .Range("A1:" & strLC)
      Rng.Copy Destination:=wks.Cells(LR, 1)
    End With
  End If
Next i
wks.Select
Columns("A:A").WrapText = False
Columns("A:A").ColumnWidth = 8
Columns("A:A").Rows.AutoFit
Columns("B:B").WrapText = True
Columns("B:B").ColumnWidth = 10
Columns("B:B").Rows.AutoFit
Columns("C:C").WrapText = True
Columns("C:C").ColumnWidth = 74
Columns("C:C").Rows.AutoFit
Columns("D:D").WrapText = True
Columns("D:D").ColumnWidth = 8
Columns("D:D").Rows.AutoFit
Columns("E:E").WrapText = True
Columns("E:E").ColumnWidth = 8
Columns("E:E").Rows.AutoFit
Columns("F:F").WrapText = True
Columns("F:F").ColumnWidth = 8
Columns("F:F").Rows.AutoFit
Columns("G:G").WrapText = True
Columns("G:G").ColumnWidth = 34
Columns("G:G").Rows.AutoFit
For Each r In ActiveSheet.UsedRange.Rows
   r.EntireRow.AutoFit
   If r.RowHeight < 25 Then r.RowHeight = 25
Next
    
With ActiveSheet.PageSetup
    .Orientation = xlLandscape
    .Zoom = 85
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With
Application.ScreenUpdating = True
MsgBox "The following paragraphs have been listed in your checklist: " & vbCr & vbCr & Msg
End Sub

Allerdings werden die ausgewählten Tabellenblätter nun in einem neuen Blatt innerhalb der bestehenden Mappe zusammengeführt, und nicht wie gewünscht in einer neuen Mappe.

 

Vieleicht kannst Du mir hier weiterhelfen?

 

Vielen Dank im Voraus.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
09.04.2014 09:44:20 cille40
NotSolved
09.04.2014 10:19:05 gabi
NotSolved
Rot Mehrere Tabellenblätter auswählen und in neue Mappe einfügen
11.04.2014 10:06:03 cille40
NotSolved