Suche+ausschneiden in Spalte B

Forumthread: Suche+ausschneiden in Spalte B

07.05.2007 20:55:15

schmidt.mueden@freenet.de

Hallo,
ich möchte alle Zeilen die in Spalte B den Begriff "5n" enthalten, ausschneiden und in einem neuen Sheet einfügen.
Beim aufnehmen eines Macros weiss ich aber nicht welche Schritte ich dafür tun
muss.
Bitte um Hilfestellung.
Gruß
S.Schmidt

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suche+ausschneiden in Spalte B

07.05.2007 21:28:00

Beni
AW: Suche+ausschneiden in Spalte B

07.05.2007 21:31:00

Frank
AW: Suche+ausschneiden in Spalte B

07.05.2007 21:49:00

Josef

AW: Suche+ausschneiden in Spalte B

07.05.2007 21:28:00

Beni

Hallo,
die Tabellennamen entsprechd anpassen.
Gruss Beni


Sub Suche_ausschneiden()
Dim lz, lr, i As Integer
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("Tabelle1") 'Quelle
Set sh2 = Sheets("Tabelle2") 'Ziel
lz = sh1.Cells(Rows.Count, 2).End(xlUp).Row ' letzte Zeile
For i = lz To 1 Step -1
If sh1.Cells(i, 2) = "5n" Then
lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' freie Zeile
sh1.Rows(i).Copy sh2.Cells(lr, 1)
sh1.Rows(i).Delete Shift:=xlUp
End If
Next i
End Sub

AW: Suche+ausschneiden in Spalte B

07.05.2007 21:31:00

Frank

Versuche es mal mit einem Makro.
Lege Dir eine Schaltfläche auf dein Blatt und hinterlege die mit einem Makro. Ungefähr so: (ich nehme an, die Reihen haben in Zeile 1 eine Überschrift)
Ich bin hundemüde und gehe jetzt ins Bett. Falls noch Fragen sind, baue ich auf weitere Mitstreiter hier, oder morgen wieder....


Private Sub cmd5n_Click()
Dim lngReihen As Long
lngReihen = ActiveSheet.UsedRange.Rows.Count
Selection.AutoFilter Field:=2, Criteria1:="=5n"
Application.ScreenUpdating = False
Rows("2:" & lngReihen).Select
Selection.Copy
Sheets("Neues Sheet").Activate
Sheets("Neuses Sheet").Range("A2").Activate
Sheets("Neuses Sheet").Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

AW: Suche+ausschneiden in Spalte B

07.05.2007 21:49:00

Josef

Hallo S.,
hier noch ein Code. Der sollte, vor allem bei großen Listen, schneller sein.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Cut_5n_NewSheet()
Dim rng As Range, rngC As Range
Dim strFirst As String
Dim objNewSheet As Worksheet, objSh As Worksheet

On Error GoTo ErrExit
GMS

Set objSh = ThisWorkbook.Sheets("Tabelle1") 'Name der Tabelle in der gesucht wird - anpassen!

Set rng = objSh.Columns(2).Find(What:="5n", LookAt:=xlWhole, after:=objSh.Range("B1"))

If Not rng Is Nothing Then

    strFirst = rng.Address

    Do

        If rngC Is Nothing Then
            Set rngC = rng.EntireRow
        Else
            Set rngC = Union(rngC, rng.EntireRow)
        End If

        Set rng = objSh.Columns.FindNext(rng)

    Loop While Not rng Is Nothing And rng.Address <> strFirst

End If

If Not rngC Is Nothing Then

    Set objNewSheet = ThisWorkbook.Worksheets.Add(after:=objSh)

    objNewSheet.Name = "Export_" & Format(Now, "ddmmyy_hhmmss")

    objSh.Rows(1).Copy objNewSheet.Range("A1")
    rngC.Copy objNewSheet.Range("A2")
    rngC.Delete
End If

ErrExit:
GMS True
Set rng = Nothing
Set rngC = Nothing
Set objSh = Nothing
Set objNewSheet = Nothing
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    .Calculation = IIf(Modus, -4105, -4135)
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Forumthread: Suche+ausschneiden in Spalte B

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread