Hallo mary,
das geht natürlich:
Sub Suchen()
Dim d, b, i, j, c
c = ActiveWorkbook.Name
b = ActiveSheet.Name
Set d = Workbooks.Add
d = ActiveWorkbook.Name
Workbooks(d).Sheets("Tabelle1").Cells.ClearContents
Workbooks(c).Sheets(b).Activate
For i = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If IsNumeric(Cells(i, 1)) = True And Cells(i, 1) >= 85 Then
Rows(i).Copy
j = j + 1
Workbooks(d).Sheets("Tabelle1").Cells(j, 1).PasteSpecial
End If
Next i
Workbooks(d).Sheets("Tabelle1").Activate
End Sub
Gruß
Holger
mary schrieb am 10.04.2008 13:42:31:
Hallo Holger,
Super Sache! Danke vielmals.
Ich habe noch eine Frage, kann man Anstatt in ein neues Tabellenblaat auch ein neue Exceldatei machen?
Dass wäre super. Danke
Gruss
Holger schrieb am 10.04.2008 13:14:41:
Hallo mary,
ich habe dir eine Lösung verfasst, bei der die zu kopierenden Zeilen in ein Blatt "Kopiertabellenblatt" geschrieben werden, das zu Beginn des Makros entweder neu angelegt oder dessen Inhalte gelöscht werden.
Ich hoffe, ich habe dich richtig verstanden.
Sub Suchen_3()
Dim d, b, i, j, a
b = ActiveSheet.Name
i = 0
For Each s In Worksheets
If "Kopiertabellenblatt" = s.Name Then i = 1: Exit For
Next
If i = 0 Then
Set d = Sheets.Add
ActiveSheet.Name = "Kopiertabellenblatt"
End If
Sheets("Kopiertabellenblatt").Cells.ClearContents
Sheets(b).Activate
For i = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If IsNumeric(Cells(i, 1)) = True And Cells(i, 1) >= 85 Then
Rows(i).Copy
j = j + 1
Worksheets("Kopiertabellenblatt").Cells(j, 1).PasteSpecial
End If
Next i
Sheets("Kopiertabellenblatt").Activate
End Sub
Viel Erfolg
Holger
mary schrieb am 10.04.2008 09:59:24:
Hallo zusammen,
Mein Problem liegt darin, dass ich nicht weiss wie ich anfangen soll.
Also ich muss aus der Spalte A alle die 85 sind ausgeben (Testweise Msgbox). Dabei muss man jedes mal die ganze Reihe kopieren.
Beispiel:
Wenn in der Zelle A45 99 steht muss man die ganze Row A45 (mit den anderen Spalten B, C, ..) kopieren und ausgeben.
Kann mir jemand helfen. Danke
Gruss |