Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Kopieren einer kompletten Zeile auf ein anderes Tabellenblatt





Frage

Hallo. Brauche dringend Hilfe. Ich habe mehrere Tabellenblätter in einer Excel-Datei. Ich möchte nun in einer Spalte nach einem bestimmten Wert suchen (in den Zellen stehen Tätigkeiten). Wenn der Inhalt übereinstimmt, möchte ich die komplette Zeile der Zelle in ein anderes Tabellenblatt kopieren. Da die Zeilen ständig aktualisiert werden, wäre es gut wenn sich wenn es dafür eine Formel gäbe, damit sich nicht immer alles neu eingeben muss. Für eine schnelle Antwort wäre ich sehr dankbar. [*][quote][sup][i]Admininfo: bitte vermeide Mehrfachanfragen in verschiedenen, bzw. gleichen Gruppen. [url=https://supportnet.de/showfaq/1085310][u][b]Ein FAQ dazu.[/b][/u][/url][/i][/sup][/quote]

Antwort 1 von nighty

hi all :)

es werden alle tabellen durchsucht ausser die aktive,in der aktiven wird das zeilenende abgetastet und die zeile rangehangen die durch das suchen gefunden worden ist,weitergesucht,rangehangen usw.

gruss nighty

Sub such()
Dim suche1 As Range
Dim zeile As Long
Dim sheetsalle As Integer
Dim eingabe As String
Dim zaehler1 As Long

rem hier eingabe bzw suchbegriff moeglichkeiten wovon von einer das voranstehende rem entfernt werden sollte

rem eingabe = Range("A1")
rem eingabe = InputBox("Bitte geben Sie den Suchbegriff ein !")

For sheetsalle = 1 To Sheets.Count
For zaehler1 = 1 To Sheets(sheetsalle).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1

rem her gegebenenfalls suchbereich anpassen

Set suche1 = Sheets(sheetsalle).Range("A" & zaehler1 & ":A" & Sheets(sheetsalle). _
UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(eingabe, LookIn:=xlValues)
If Not suche1 Is Nothing Then
If ActiveSheet.Index <> sheetsalle Then
Sheets(sheetsalle).Range(suche1.Row & ":" & suche1.Row).Copy
letzte = Sheets(ActiveSheet.Index).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
Rows(letzte & ":" & letzte).Insert Shift:=xlDown
Sheets(1).Application.CutCopyMode = False
zaehler1 = suche1.Row + 1
End If
End If
Next zaehler1
Next sheetsalle
End Sub