Macro zusammenfügen
18.04.2013 07:48:19
chris58
Ich habe diesen Code aus diesem Forum und ersuche, ob mir wer hier helfen kann, wie ich diesen Code auch auf andere/ mehrere Konten anwenden kann.
Option Explicit
Public Sub AuswaehlenKopieren()
Dim WkSh_Q As Worksheet
Dim WkSh_Z As Worksheet
Dim rZelle As Range
Dim sFundst As String
Dim sSuchbegriff As String
Dim lZeile_Z As Long
sSuchbegriff = "Finanzamt" ' der zu suchende Begriff
lZeile_Z = 1 ' die erste Ausgabezeile -1
Application.ScreenUpdating = False
Set WkSh_Q = Worksheets("Saldenliste") ' den Tabellenblattnamen ggf. anpassen !!!
Set WkSh_Z = Worksheets("Finanzamt") ' den Tabellenblattnamen ggf. anpassen !!!
With WkSh_Q.Columns(3)
' wenn der gesamte Suchbegriff gefunden werden soll muss es
' xlWhole anstelle von xlPart heißen.
Set rZelle = .Find(sSuchbegriff, LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
lZeile_Z = lZeile_Z + 1
WkSh_Q.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(lZeile_Z)
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
Else
MsgBox "Zum gesuchen Begriff """ & sSuchbegriff & _
""" wurde kein Eintrag gefunden.", _
48, " Hinweis für " & Application.UserName
End If
End With
Option Explicit
Public Sub AuswaehlenKopieren()
Dim WkSh_Q As Worksheet
Dim WkSh_Z As Worksheet
Dim rZelle As Range
Dim sFundst As String
Dim sSuchbegriff As String
Dim lZeile_Z As Long
sSuchbegriff = "KreditZahlung" ' der zu suchende Begriff
lZeile_Z = 1 ' die erste Ausgabezeile -1
Application.ScreenUpdating = False
Set WkSh_Q = Worksheets("Saldenliste") ' den Tabellenblattnamen ggf. anpassen !!!
Set WkSh_Z = Worksheets("KreditZahlung") ' den Tabellenblattnamen ggf. anpassen !!!
With WkSh_Q.Columns(3)
' wenn der gesamte Suchbegriff gefunden werden soll muss es
' xlWhole anstelle von xlPart heißen.
Set rZelle = .Find(sSuchbegriff, LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
lZeile_Z = lZeile_Z + 1
WkSh_Q.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(lZeile_Z)
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
Else
MsgBox "Zum gesuchen Begriff """ & sSuchbegriff & _
""" wurde kein Eintrag gefunden.", _
48, " Hinweis für " & Application.UserName
End If
End With
Application.ScreenUpdating = True
End Sub
Wie kann ich diese beiden Code zu einem zusammenfügen.
Danke für die Hilfe
chris58