Adress-Script ändern
Nicole
folgendes Script (Formular) sucht mir die Adressdaten aus dem Blatt "Adressen" in der gleichen Tabelle.
Ich würde gerne die Adressdaten in eine andere Tabelle mit dem Namen
"Adressdatenbank" ausgliedern.
Könnte mir ein VBA-Kenner netterweise das Script so anpassen, das die Adressen in einer anderen Tabelle gesucht werden, welche auch geschlossen ist.
Schon mal Danke für die nicht selbstverständliche Mühe !!
Option Explicit
Sub Adresse()
frmSearch.Show
End Sub
-------------------------
Option Explicit
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
With ListBox1
If .ListIndex > -1 Then
Sheets("Rechnung").Range("B10") = .List(.ListIndex, 0) & " " & .List(.ListIndex, 1)
Sheets("Rechnung").Range("B9") = .List(.ListIndex, 2)
Sheets("Rechnung").Range("B12") = .List(.ListIndex, 3)
Sheets("Rechnung").Range("B13") = .List(.ListIndex, 4)
Sheets("Rechnung").Range("B11") = .List(.ListIndex, 8)
End If
End With
End Sub
Private Sub cmdSearch_Click()
Dim rng As Range
Dim wks As Worksheet
Dim sFirst As String, sFind As String, strWidth As String
Dim iCnt As Integer, n As Integer, lastCol As Integer
Set wks = Sheets("Adressen")
lastCol = wks.Range("IV3").End(xlToLeft).Column
With ListBox1
.Clear
.ColumnCount = lastCol + 1
For iCnt = 1 To .ColumnCount - 1
strWidth = strWidth & "100;"
Next
strWidth = strWidth & "0"
.ColumnWidths = strWidth
sFind = txtSearch
Set rng = wks.Range("A4:IV65536").Find(What:=sFind, LookIn:=xlValues, _
lookat:=xlPart, after:=wks.Range("IV65536"))
If Not rng Is Nothing Then
sFirst = rng.Address
Do
.AddItem wks.Cells(rng.Row, 1)
For iCnt = 2 To lastCol + 1
.List(n, iCnt - 1) = wks.Cells(rng.Row, iCnt)
Next
.List(n, .ColumnCount - 1) = rng.Row
n = n + 1
Set rng = wks.Range("A4:IV65536").FindNext(rng)
Loop While rng.Address <> sFirst
End If
End With
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub txtSearch_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then cmdSearch_Click 'bei ENTER in der TextBox wird die Suche gestartet
End Sub
Gruß Nicole