title image


Smiley Re: Daten von mehreren Blättern mit Bedingung zusammenfassen
Hi!



Probiers mal so:



Sub SheetCopy()

Dim Ws, WsZ As Worksheet

Dim Rw As Long

Set WsZ = Worksheets("Zusammenfassung")



WsZ.Cells.Delete



For Each Ws In ActiveWorkbook.Worksheets

If Ws.Name "Zusammenfassung" Then

For Rw = 1 To Ws.UsedRange.Rows.Count

If Ws.Cells(Rw, 2) > 0 Then

Ws.Rows(Rw).Copy

If Not WsZ.[A1].End(xlDown).Row = 65536 Then

WsZ.[A1].End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll

Else

WsZ.[A1].PasteSpecial xlPasteAll

End If

End If

Next Rw

End If

Next Ws



Set WsZ = Nothing

End Sub

Grüße

 

LXus

 

Win7 x64

Office 2013 x64



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: