Makroveränderung kopieren
23.06.2015 08:06:28
Thomas
ich habe hier ein Makro gefunden welches innerhalb des Tabellenblatts ( Vorgang ) nach einen Begriff sucht und die Ergebniszeilen in das Blatt "Begriffauswertung" kopiert.
Dies ist auch super nur leider werden die Formeln mitkopiert ich benötige jedoch nur die Formate und die Werte. ( Falls nur die Werte gehen ist dies auch ok).
Toll wäre auch wenn ich im Makro selbst die Spalten welche kopiert werden sollen mit angeben könnte.
Kann hier jemand helfen?
Oder hat jemand so etwas vielleicht schon?
vielen dank schon mal im voraus.
liebe Grüße thomas
Sub Begriff_Suchen_Kopieren_Begriffauswertung()
'Sucht einen Begriff in einem bestimmten Blatt,
'und kopiert die Ergebnisse in ein anderes Blatt
Static Suchbegriff As String
'Hinweis zur Variablendeklaration: Im Beispielcode waren nur
'jeweils die letzten Variablen korrekt deklariert. Alle anderen
'Variablen waren (autom.) vom Typ "Variant". Es reicht nicht,
'den Typ nur am Ende einer Zeile anzugeben.
Dim Zelle As Variant, ErsteAdresse As String
Dim LetzteZelle As Integer, intCount As Integer
Application.ScreenUpdating = False
Worksheets("Begriffauswertung").Cells.Clear 'Alte Tabelleninhalte löschen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben:", _
Default:=Suchbegriff)
If Suchbegriff = "" Then Exit Sub
With Worksheets("vorgang")
'Überschriftenzeile kopieren ...
.Rows(1).Copy Destination:=Worksheets("Begriffauswertung").Range("a1")
With .UsedRange
Set Zelle = .Find(What:=Suchbegriff, After:=Range("A1"), _
LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlNext, MatchCase:=True)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
LetzteZelle = 2
Do
.Rows(Zelle.Row).Copy _
Destination:=Worksheets("Begriffauswertung") _
.Cells(LetzteZelle, 1)
Set Zelle = .FindNext(Zelle)
LetzteZelle = LetzteZelle + 1
Loop While Not Zelle Is Nothing And _
Zelle.Address ErsteAdresse
End If
Worksheets("Begriffauswertung").Select
Range("a1").Select
End With
End With
Application.ScreenUpdating = True
End Sub