Hallo in die Runde
ich habe mal eine Frage zu diesem Makro ist es möglich es so anzupassen das ich die Zielzeilen die sich in Tabelle 2 sind so anzupassen das ich sie selber auswählen kann wenn ich bisher die Spalten ändere kann
also das zb das er mir Spalte A aus Tabelle 1 in Spalte E in Tabelle 2 setzt irgendwie stehe ich hier völlig auf dem schlauch
einmal der Code für euch zum drüber schauen und danke schon mal für eure mühe und Hilfe
Sub kopieren()
Dim Suchergebnis As Range
Dim lngZielZeile As Long
Dim Suchwert As String
Dim lngZaehler As Long
Dim firstAddress
Dim intSpalte As Integer
lngZielZeile = 3
Suchwert = "Knöpfe" 'Suchwert eingeben (Welche Maschine zb.)
lngZaehler = 0
With Sheets("Tabelle1") ' Tabelle in welcher der Wert gesucht wird bitte den richtigen Tabellenamen angeben der auch unten im Reiter steht
Set Suchergebnis = .Range("A5:AY30").Find(Suchwert, LookIn:=xlValues, lookat:=xlWhole) 'hier wird der Suchbereich angegeben in welcdhem der passenden Werte gesucht wird
If Not Suchergebnis Is Nothing Then
firstAddress = Suchergebnis.Address
Do
For intSpalte = 1 To 4 'welche Spalten sollen Kopiert werden? wird Spaltennummern kann durch die Zahlen geändert werden
Sheets("Tabelle2").Cells(lngZielZeile, intSpalte) = .Cells(Suchergebnis.Row, _
intSpalte)
Next
For intSpalte = 5 To 14 'welche Spalten sollen Kopiert werden? wird Spaltennummern können durch die Zahlen geändert werden
Sheets("Tabelle2").Cells(lngZielZeile, intSpalte) = .Cells(Suchergebnis.Row, _
intSpalte + 1)
Next
lngZielZeile = lngZielZeile + 1
lngZaehler = lngZaehler + 1
Set Suchergebnis = .Range("A5:AY30").FindNext(Suchergebnis) ' Suchbereich von der Tabelle1(Produktionsplanung)
Loop While Not Suchergebnis Is Nothing And Suchergebnis.Address <> firstAddress
MsgBox "Es wurden zum Suchwert " & Suchwert _
& vbCrLf & lngZaehler & " Datensätze kopiert" 'Textbox für die Ausgabe was gefunden wurde kann Variabel angepasst werden oder gelöscht werden
Else
MsgBox "Kein Eintrag" 'Textbox wenn nix Gefunden wurde kann Variabel angepasst werden
End If
End With
End Sub
|