ich habe eine Excel-Liste mit 17 Tabellen-Blätter. Für eine Auswertung möchte ich 10 Tabellen-Blätter möglichst über einen VBA-Code zu einem Tabellenblatt zusammenfassen. Der Kopf der Auswertung ist definiert und fest. Ich benötige daher von den 10 Tabellen-Blätter nur die reinen Daten (die Anordnung ist bei allen gleich). Im Internet gibt es paar Beispiele, jedoch komme ich nicht weiter. Hat jemand eventuell mal das gleiche Problem gehabt und eine lösung?
Sub Phillipp()
Dim i As Long, lr As Long
If Not Sheets(1).Name = "Gesamt" Then
Sheets.Add before:=Sheets(1)
Sheets(1).Name = "Gesamt"
Else
Sheets("Gesamt").Cells = ""
End If
Sheets("Gesamt").Rows(1).Value = Sheets(4).Rows(1).Value
For i = 2 To Sheets.Count
lr = Sheets("Gesamt").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets(i).UsedRange
Sheets("Gesamt").Cells(lr, 1).Resize(.Rows.Count - 1, .Columns.Count).Value = _
.Resize(.Rows.Count - 1).Offset(1).Value
End With
Next i
End Sub
habe mal eine Testdatei im Anhang gepackt. dort klappt es. Über die "Daten" weise zu zu, welche Tabellenblätter ich auswerten will.
in meiner richtigen umfangreichen Datei, möchte ich ab Zeile A4 bis W4 und nach unten offen ohne kopf die Daten zusammenfassen.
ich habe eine excel-liste mit mehrenen Excel-Blätter mit verschiedenen daten, jedoch ist die anordnung im tabellenkopf immer gleich. Ich möchte von meinen 17 excelblättern nur 10 auswählen. die augewählten daten möchte ich in ein excel-blatt/liste zusammenfügen. jedoch nur mit einem tabellenkopf am anfang. die folge daten dann ohne.
mit folgendem VBA-Code bekomme ich es fast hin. Was fehlt und noch nicht funktioniert ist, dass ich von den 17 Excel-Sheets nur 10 (Nummer 1 bis Nummer 10) zusammenfügen möchte. Hätte jemand dazu eine Ergänzung im VBA-Code?
Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A2").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub