20 Files, jeweis 7 Sheets, Sinnvolle übersicht

[smara]

Moin,

Sub TabellenKopierenUntereinander()
Dim i As Integer
Dim LRow As Long

Application.ScreenUpdating = False
'neue Tabelle an die erste Position einfügen
Sheets.Add Before:=Sheets(1)

For i = 2 To Sheets.Count
    'Ermitteln den benutzen Bereich der einzelnen Tabellenblätter
    With Sheets(i)
        LRow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("B2:P2" & LRow).Copy Sheets(1).Cells(Rows.Count, "A").End(xlUp)(2)
    End With
Next
Application.ScreenUpdating = True
End Sub


Arbeitsmappe XY mit 7 Tabellenblätter

Die Tabellen sind nicht immer gleich groß und werden nur bis A21 auf ein neues Tabellenblatt kopiert... 

Tabellen fangen bei B2:max bis P2 und Bxy:Pxy (xy=Variable Länge)

Was noch super wäre, wenn zwischen den Tabellen zwei leere Zelle eingeführt werden könnten.

Und wie könnte man diese Zwei codes verbinden?

Sub Makro1()
Dim wks As Worksheet
For Each wks In Worksheets
Worksheets(wks.Name).Range("B1").Value = wks.Name
Worksheets(wks.Name).Range("B1").Characters(0, Len(A)).Font.Bold = True
Worksheets(wks.Name).Range("B1").Characters(0, Len(A)).Font.Size = 13
Next wks
End Sub


Danke!

[snb]

Wie viel willst du für diese Arbeit bezahlen?

[smara]

Das hatte ich noch nicht überlegt....
Habe das aber mit den kopieren bis Tabelle 21 mittlerweile gelöst...

Muss nun nur noch die Auswertung machen...

[Gast 123]

Hallo

Amüsanter Rangefehler im Code.  Ich kann ihn mir technisch nicht erklaeren!

Interessant das die Aufgabe schon gelöst ist.  Ich habe aber eine fachlich interessante Frage an  snb  ....
Wie man in der Beisipieldatei sehen kann stimmt der Range Bereich nicht. Das verblüfft mich sehr.

Woran liegt das, und die Frage ist, wie funktioniert dann der Code beim Frager???
Das Beispiel ist eine 2003 Fatei OHNE Module. Das Makro findet ihr im Sheet4. Testet es bitte mal ... 

mfg  Gast 123

[snb]

Besser wäre:

Code:

Sub M_tst()
  Sheet3.UsedRange.Offset(1, 1).Resize(, 14).copy
End Sub

P2 & 1 = P21