932 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo Excel-Experten,

mein Problem ist in ähnliche Form schon mal besprochen worden (Ratgeber war Coros), leider bin ich aber ein Makro-Analphabet und nicht in der Lage, die Lösung auf meinen Fall anzupassen. Daher bitte ich um eure Hilfe:

Ich habe ein Tabellenblatt namens IMP, in das ich mir Daten (das können bis zu 2000 Zeilen sein) über eine Index-Funktion aus einer anderen, externen Datei importiere.

Ein Makro soll nun Zeile für Zeile durch dieses Blatt gehen und immer dann, wenn in Spalte B (kann Text oder eine Zahl enthalten) bestimmte Kriterien erfüllt sind (z. B. Wert entspricht "Kriterium" oder 1913 oder 1932), die ganze Zeile in ein anderes, bereits existentes Blatt namens MET schreiben.

Da in MET bereits von einer früheren Auswertung Daten stehen können, sind die Zellen dieses Blattes vorher zu löschen (ohne aber die Formatierungen zu eliminieren).

Ich würde mich riesig freuen, wenn mir ein Excel-Experte helfen kann.

Tom

2 Antworten

0 Punkte
Beantwortet von
... noch als Ergänzung:

Ein ähnliches Problem von einem anderen Forum-User hat Coros irgendwann mal beantwortet und folgenden Makro-Code vorgeschlagen:

Option Explicit

Sub Auswertmakro()
Dim Zeile As Long, Blattname_alt As String, _
Wiederholungen As Long
Application.ScreenUpdating = False
Blattname_alt = ActiveSheet.Name
Sheets.Add.Name = "Auswertung"
Sheets(Blattname_alt).Activate
For Wiederholungen = 2 To 180
If Cells(Wiederholungen, 5) < 2000 Then
Zeile = Sheets("Auswertung").Range("E65536"). _
End(xlUp).Offset(1, 0).Row
Rows(Wiederholungen).Copy _
Sheets("Auswertung").Cells(Zeile, 1)
End If
Next
End Sub

Vielleicht ist das als Startpunkt zur Problemlösung hilfreich und kann von jemandem auf mein Problem angepasst werden ???
0 Punkte
Beantwortet von m-o-m Mitglied (499 Punkte)
Hallo Tom,

ich hab mal versucht was zu bauen. Auch wenn ich bei Makros nicht wirklich sicher bin.

Ich habe in Zeile 1 einen Autofilter eingerichtet.

Schaue es dir mal an:


Sub Makro()
ActiveSheet.Range("$B$1:$C$2100").AutoFilter Field:=1, Criteria1:=Array( _
"1912", "1932", "Kriterium"), Operator:=xlFilterValues
Rows("2:2100").Select
Selection.Copy
Sheets("MET").Select
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Rows("2:2").Select
Sheets("IMP").Select
Selection.Copy
Sheets("MET").Select
Rows("2:2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Sheets("IMP").Select
Range("A1").Select
ActiveSheet.Range("$B$1:$C$2100").AutoFilter Field:=1
Application.CutCopyMode = False
Selection.ClearContents
End Sub


Gruß Maik
...