Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<
Microsoft Office 2003-2019 => Excel => Thema gestartet von: chisru am Februar 07, 2018, 11:36:04 Vormittag
Titel: VBA umschreiben
Beitrag von: chisru am Februar 07, 2018, 11:36:04 Vormittag
Guten Tag zusammen, ich habe einen vba code, der soweit wie ich möchte funktioniert. nur möchte ich nicht, dass es von allen Tabellenblättern zusammenzieht, sondern nur von Tabellenblatt DEB1 und DEB2. Kann mir da vielleicht jemand weiterhelfen ? Vielen Dank schon im Voraus.
Sub Workbook_SheetActivate(ByVal Sh As Object) If Sh.Name = "Zusammenfassung" Then collectSheets End If
setzeCursor End Sub
Sub collectSheets()
Application.ScreenUpdating = False 'Speedup
Dim objWks As Worksheet Dim nCounter As Integer 'Anzahl Sheets Dim nNumWS As Integer 'aktuelles Sheet Dim zuLastRow As Long 'letzte Zelle aktuelles Sheet Dim lastRow As Long 'letzte Zelle Sheet Zusammenfassung
nNumWS = Worksheets.Count 'Summe Sheets 'bereite Zusammenfassung vor (lösche alte Werte) Sheets("Zusammenfassung").Rows("2:" & Sheets("Zusammenfassung").Cells(65536, 2).End(xlUp).Row).Delete 'Shift:=xlUp
For nCounter = 1 To nNumWS
Set objWks = Worksheets(nCounter) 'akuelles Sheet
If objWks.Name <> "Zusammenfassung" Then 'ignoriere Zusammenfassung If WorksheetFunction.CountA(objWks.Rows(2)) > 0 Then 'wenn Zeile 2 gefüllt lastRow = objWks.Cells(65536, 2).End(xlUp).Row 'letzte gefüllte Zeile aktuelles Sheet zuLastRow = Sheets("Zusammenfassung").Cells(65536, 2).End(xlUp).Row + 1 'letzte gefüllte Zeile+1 Zusammenfassung
objWks.Rows("2:" & lastRow).Copy Sheets("Zusammenfassung").Cells(zuLastRow, 1) ' Kopiervorgang End If End If Next 'nCounter
Set objWks = Nothing 'Speicher aufräumen
Application.ScreenUpdating = True
End Sub
Titel: Antw: VBA umschreiben
Beitrag von: maninweb am Februar 07, 2018, 17:24:10 Nachmittag
Hallo,
auf die schnelle und ungetestet, ersetze mal ...
Code: Visual Basic
If objWks.Name <> "Zusammenfassung"Then 'ignoriere Zusammenfassung