Thema Datum  Von Nutzer Rating
Antwort
14.12.2020 02:29:13 Sebastian
NotSolved
Blau Makro mit vielen Tabellenblättern
14.12.2020 10:15:50 volti
NotSolved
14.12.2020 11:58:25 Ulrich
NotSolved
14.12.2020 12:01:56 Gast32764
NotSolved
14.12.2020 17:33:20 volti
NotSolved
14.12.2020 19:25:50 Gast90153
NotSolved
14.12.2020 19:43:24 volti
NotSolved
14.12.2020 20:02:45 Sebastian
NotSolved
15.12.2020 00:47:45 volti
NotSolved
15.12.2020 01:32:41 Sebastian
NotSolved
15.12.2020 09:50:05 volti
NotSolved
15.12.2020 14:47:55 Sebastian
NotSolved
15.12.2020 15:19:33 volti
NotSolved
15.12.2020 16:05:40 volti
NotSolved
28.02.2021 23:46:30 Sebastian
NotSolved
01.03.2021 09:22:12 volti
NotSolved

Ansicht des Beitrags:
Von:
volti
Datum:
14.12.2020 10:15:50
Views:
772
Rating: Antwort:
  Ja
Thema:
Makro mit vielen Tabellenblättern

Hallo Sebastian,

zu Antwort 1: Da kann ich leider nichts zu sagen, schon gar nicht ohne Mustermappe...

zu Antwort 2: Du solltest die Störfaktoren wie die ständige Bildschirmaktualisierung abschalten, dann geht es auch schneller.

Hier mal ein etwas angepasster Code zur evtl. weiteren Verwendung (ungetestet):

PS: Bei .Rows(i).Copy Destination:=tbl1.Rows(a) bin ich mir unsicher, ob's funktioniert, da ich mit diesen Listobjects nch nicht gearbeitet habe.

Code:
 
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
Option Explicit

Sub Zusammenfassung()
  
  Dim i, a, b As Integer
  Dim tbl1, tbl2 As ListObject
  Dim loLetzte As Integer
  
  Set tbl1 = Worksheets("xxx").ListObjects("Tabelle13")
  Set tbl2 = Worksheets("yyy").ListObjects("Tabelle14")
  
  If tbl1.ListRows.Count >= 1 Then
     tbl1.DataBodyRange.Delete
  End If
  
  If tbl2.ListRows.Count >= 1 Then
     tbl2.DataBodyRange.Delete
  End If


  With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
  End With
  
  With Worksheets("GSV").ListObjects("Tabelle1").DataBodyRange
     For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
        
        Select Case .Cells(i, 2)
        Case "xxx": a = a + 1
           .Rows(i).Copy Destination:=tbl1.Rows(a)
'            .Rows(i).Copy Destination:=Worksheets("xxx").Range(tbl1).Rows(a)
          
        Case "yyy": b = b + 1
           .Rows(i).Copy Destination:=tbl2.Rows(b)
'            .Rows(i).Copy Destination:=Worksheets("yyy").Range(tbl2).Rows(b)
        End Select
        
     Next i
  End With
  
  With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
  End With
  
End Sub
 
_________
viele Grüße
Karl-Heinz

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
14.12.2020 02:29:13 Sebastian
NotSolved
Blau Makro mit vielen Tabellenblättern
14.12.2020 10:15:50 volti
NotSolved
14.12.2020 11:58:25 Ulrich
NotSolved
14.12.2020 12:01:56 Gast32764
NotSolved
14.12.2020 17:33:20 volti
NotSolved
14.12.2020 19:25:50 Gast90153
NotSolved
14.12.2020 19:43:24 volti
NotSolved
14.12.2020 20:02:45 Sebastian
NotSolved
15.12.2020 00:47:45 volti
NotSolved
15.12.2020 01:32:41 Sebastian
NotSolved
15.12.2020 09:50:05 volti
NotSolved
15.12.2020 14:47:55 Sebastian
NotSolved
15.12.2020 15:19:33 volti
NotSolved
15.12.2020 16:05:40 volti
NotSolved
28.02.2021 23:46:30 Sebastian
NotSolved
01.03.2021 09:22:12 volti
NotSolved