Makro verändern / ergänzen
29.08.2003 20:24:44
Dieter D.
bin mittlerweile recht enttäuscht, habe mehrmals versucht Hilfe zu einem Makro
zu erhalten, leider ohne den gewünschten Erfolg.
Ich möchte ein bestehendes Makro, welches nicht von mir erstellt wurde, erweitern / verändern.
Habe schon diverse Beispiele von Herbers Cd getestet, schaffe es
aber nicht, den Ablauf auf meine Bedürfnisse hin zu optimieren.
Da ich nicht der VBA-Kenner bin, würde ich gerne über dieses Forum Lösungsvorschläge erhalten.
So, hier nun der Versuch, mein Problem darzustellen:
Mein Makro, welches Daten über einen Suchbegriff in eine Neue
Arbeitsmappe einliest, soll dahin gehend verändert werden, dass die Daten als
neues Tabellenblatt mit in die bestehende Arbeitsmappe SozialDaten kopiert wird.
Ich stelle dieses Makro einfach mal mit ins posting, vielleicht hilft es Euch,
mein Anliegen besser zu verstehen.
Modul 1
Sub Such_mich()
Dim sPath As String
Dim Suchtext As String
Dim Zelle As Range
Dim i As Long
Dim j As Integer
Dim KopierteZeilen()
Dim NeueMappe As Worksheet
Dim Arbeitsmappe As String
Dim Schon_da As Boolean
Suchtext = InputBox("Wonach suchen?", , "Arbeit macht Spaß ! oder ?")
If Suchtext <> "" Then
Arbeitsmappe = ActiveWorkbook.Name
Workbooks.Add
Set NeueMappe = ActiveWorkbook.ActiveSheet
i = 2
Workbooks(Arbeitsmappe).Activate
Rows("2:2").Copy NeueMappe.Cells(1, 1)
For Each Zelle In Workbooks(Arbeitsmappe).ActiveSheet.UsedRange
If InStr(1, Zelle.Value, Suchtext, vbTextCompare) > 0 Then
ReDim Preserve KopierteZeilen(i - 2)
Schon_da = False
For j = 0 To UBound(KopierteZeilen)
If KopierteZeilen(j) = Zelle.Row Then Schon_da = True
Next
If Not Schon_da Then
Rows(Zelle.Row & ":" & Zelle.Row).Copy NeueMappe.Cells(i, 1)
i = i + 1
End If
End If
Next
NeueMappe.Activate
Columns("A:Z").EntireColumn.AutoFit
Range("A1").Select
End If
End Sub
Wer ist vielleicht so freundlich und hilft mir weiter?
Verbleibe mit freundlichen Grüßen
Dieter