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
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