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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen