Arbeitsblätter zusammenführen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Arbeitsblätter zusammenführen
von: Thomas H
Geschrieben am: 07.09.2015 23:06:30

Hallo,
ich habe eine Exceldatei mit mehreren Arbeitsblättern (alle identisch aufgebaut) und möchte jeweils eine Zeile davon in ein neues Arbeitsblatt kopiere. Ich habe zwar jede Menge VBA Codes dafür gefunden aber alle haben das gleiche Problem, es wird der gesamte Inhalt der Arbeitsblätter kopiert. Leider fehlen mir die Kenntnisse um den Code richtig anzupassen.
Kann mir jemand verraten, was ich editieren muss, damit von jedem Arbeitsblatt nur die Zeile A3 bis M3 kopiert wird?
Ich benutze momentan folgenden Code:

Sub neut()
For i = 1 To Sheets.Count + 1
    If i > Sheets.Count Then
       Set NewSheet = Worksheets.Add
       NewSheet.Name = "Auswertung"
    End If
    If Sheets(i).Name = "Auswertung" Then
       MsgBox "Tabellenblatt Auswertung ist bereits vorhanden!"
       Exit For
    End If
Next i
Set ws1 = Worksheets("Auswertung")
anz1 = ws1.Cells(65356, 1).End(xlUp).Row
ws1.Range("a3:m" & anz1).ClearContents
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Auswertung" Then
       anz1 = ws1.Cells(65356, 1).End(xlUp).Row
       Set ws2 = Worksheets(Sheets(i).Name)
       anz2 = ws2.Cells(65356, 1).End(xlUp).Row
       ws2.Range("a3:m" & anz2).Copy Destination:=ws1.Range("a" & anz1 + 1)
       
    End If
Next i
End Sub

Vielen Dank für Eure Hilfe

Bild

Betrifft: AW: Arbeitsblätter zusammenführen
von: Sepp
Geschrieben am: 07.09.2015 23:30:54
Hallo Thomas,
der Code ist murks!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub auswertung()
Dim lngRow As Long, objSh As Worksheet, objAW As Worksheet

lngRow = 3

On Error Resume Next
Set objAW = Sheets("Auswertung")
Err.Clear
On Error GoTo 0

If objAW Is Nothing Then
  With ThisWorkbook
    Set objAW = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
    objAW.Name = "Auswertung"
  End With
End If

With objAW
  .Range("A3:M" & .Rows.Count) = ""
  For Each objSh In ThisWorkbook.Worksheets
    If Not objSh.Name = .Name Then
      objSh.Range("A3:M3").Copy .Cells(lngRow, 1)
      lngRow = lngRow + 1
    End If
  Next
End With

Set objAW = Nothing
Set objSh = Nothing
End Sub


Gruß Sepp


Bild

Betrifft: AW: Arbeitsblätter zusammenführen
von: Thomas H
Geschrieben am: 08.09.2015 07:21:29
Hallo Sepp,
vielen Dank für die schnelle Antwort, genau das habe ich gesucht.
Gibt es noch die Möglichkeit, dass nur die Werte ohne Formeln kopiert werden, da jetzt teilweise der Zellbezug fehlt?
Gruß, Thomas

Bild

Betrifft: AW: Arbeitsblätter zusammenführen
von: Sepp
Geschrieben am: 08.09.2015 08:13:21
Hallo Thomas,
statt

objSh.Range("A3:M3").Copy .Cells(lngRow, 1)
schreibe
.Cells(lngRow, 1).Resize(1, 13) = objSh.Range("A3:M3").Value
Gruß Sepp

Bild

Betrifft: AW: Arbeitsblätter zusammenführen
von: Thomas H
Geschrieben am: 08.09.2015 08:23:08
Hallo Sepp,
funktioniert super. Vielen tausend Dank!
Gruß, Thomas

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Arbeitsblätter zusammenführen"