Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1444to1448
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Arbeitsblätter zusammenführen

Arbeitsblätter zusammenführen
07.09.2015 23:06:30
Thomas
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitsblätter zusammenführen
07.09.2015 23:30:54
Sepp
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

Anzeige
AW: Arbeitsblätter zusammenführen
08.09.2015 07:21:29
Thomas
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

AW: Arbeitsblätter zusammenführen
08.09.2015 08:13:21
Sepp
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

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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige