Thema Datum  Von Nutzer Rating
Antwort
14.12.2020 02:29:13 Sebastian
NotSolved
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
Rot Makro mit vielen Tabellenblättern
 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:
15.12.2020 00:47:45		 Views:
782		 Rating:
     
Antwort:
  Ja
Thema:
Makro mit vielen Tabellenblättern

Hallo Sebastian,

habe mich ein wenig mit Deiner Datei beschäftigt. Die LetzteZeile-Ermittlung läuft hier dann schon anders als angenommen. Vielleicht liegt Dein Problem daran.

Deinen ganzen bisherigen Code könnte man mit geschickter Array-Verwendung auf den u.a. Code reduzieren. Also alle Module entfernen und nur den u.a. Code verwenden.

Bitte teste mal, ob alle Eventualitäten abgedeckt sind. Falls alles klappt soweit, kannst Du später einfach neue Tabellen einfügen, ohne überhaupt am Code etwas anpassen zu müssen.

Falls noch was nicht klappt, melde Dich einfach noch mal:

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
50
51
52
53
54
55
56
57
58
59
60
61
62		  
Option Explicit

Sub Gesamt()
  Dim i As Long, j As Long
  Dim sArrBlatt() As String, sArrList() As String, iZeile() As Long

' Speed ein
  With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
  End With

' Einlesen der Tabellenblattnamen und Listobjektnamen in Array
  For i = 1 To ThisWorkbook.Worksheets.Count
     ReDim Preserve sArrBlatt(i)
     ReDim Preserve sArrList(i)
     sArrBlatt(i) = ThisWorkbook.Worksheets(i).Name
     sArrList(i) = ThisWorkbook.Worksheets(i).ListObjects(1)
  Next i
  ReDim iZeile(UBound(sArrBlatt))

' Löschen der Datenbereiche aller Tabellen
  For i = 1 To UBound(iZeile)
     If Not sArrBlatt(i) Like "GSV" Then
        With ThisWorkbook.Worksheets(sArrBlatt(i)).ListObjects(sArrList(i))
           If .ListRows.Count >= 1 Then .DataBodyRange.Delete
        End With
     End If
  Next i
  
' Übertragen der Daten
  With ThisWorkbook.Worksheets("GSV").ListObjects("Tabelle1").DataBodyRange
     For i = 1 To .Rows.Count
        For j = 1 To UBound(iZeile)
           If sArrBlatt(j) Like "*" & .Cells(i, 2).Value & "*" Then
              iZeile(j) = iZeile(j) + 1
              ThisWorkbook.Worksheets(sArrBlatt(j)).Range(sArrList(j)).Rows(iZeile(j)).Value = .Rows(i).Value
              Exit For
           End If
        Next j
     Next i
  End With
  
' Formatieren der Spaltenbreite aller Tabellen
  On Error Resume Next
  For i = 1 To UBound(iZeile)
     If Not sArrBlatt(i) Like "GSV" Then
        Worksheets(sArrBlatt(i)).ListObjects(sArrList(1)).Columns.AutoFit
     End If
  Next i

' Speed aus
  With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
  End With
  
  MsgBox "Fertig!", vbInformation, "Datenübertragung"
  
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
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
Rot Makro mit vielen Tabellenblättern
 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