Sub AufDieSchnelle
Dim intSum as integer
Dim rngCells as range
Dim rngTarget as range
Set rngCells = WorkSheet("Tabelle 1).Range("A10:J109")
Set rngTarget = WorkSheet("Tabelle 2).Range("A10:J109")
Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(A10:A109)"
intSUm = Range("A1").Value
if intSum > 0 then
rngCells.Select
rngCells.copy
rngtarget.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
else
exit sub
end if
End Sub
Private Sub CommandButton1_Click()
Dim lngLastRow As Long, lngZeile As Long, lngSpalte As Long
Dim myBereich
Const myWert = 0
With Sheets("Tabelle1")
myBereich = .Range(.Cells(1, 1), .Cells(109, 10))
For lngZeile = 10 To Ubound(myBereich, 1)
For lngSpalte = Lbound(myBereich, 2) To Ubound(myBereich, 2)
If .Cells(lngZeile, lngSpalte) > myWert Then
lngLastRow = Sheets("Tabelle2").Cells(Rows.Count, lngSpalte).End(xlUp).Row + 1
Sheets("Tabelle2").Cells(lngLastRow, lngSpalte) = .Cells(lngZeile, lngSpalte)
End If
Next lngSpalte
Next lngZeile
End With
End Sub
Dim i As Long
Application.ScreenUpdating = False
For i = 10 To 109
If Sheets("Tabelle1").Cells(i, 1) > 0 Then
Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 10)).Copy
Sheets("Tabelle2").Cells(i, 1).PasteSpecial Paste:=xlPasteValues
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
Option Explicit
Private Sub CommandButton1_Click()
Dim loA As Long
Dim loLetzte As Long
loLetzte = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row 'Tabellenname anpassen
For loA = 10 To 109
If Cells(loA, 1) > 0 Then
'Rows(loA).Copy Destination:=Sheets("Tabelle2").Rows(loLetzte) 'ganze Zeile kopieren
Range(Cells(loA, 1), Cells(loA, 10)).Copy Destination:=Sheets("Tabelle2").Cells(loLetzte, 1) ' _
Spalte A bis J kopieren
loLetzte = loLetzte + 1
End If
Next
End Sub
Option Explicit
Private Sub CommandButton1_Click()
Dim loA As Long
Dim loLetzte As Long
loLetzte = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row 'Tabellenname anpassen
For loA = 10 To 109
If Cells(loA, 1) > 0 Then
Range(Cells(loA, 1), Cells(loA, 10)).Copy
Sheets("Tabelle2").Cells(loLetzte, 1).PasteSpecial Paste:=xlPasteValues
loLetzte = loLetzte + 1
End If
Next
End Sub