Hallo Nero,
ist die Tabelle mit den Terminen in der gleichen Arbeitsmappe?
Termine kopieren von - bis ?
In welcher Spalte eintragern?

Gruß
fedjo

Hallo,
also die excel tabelle termine liegt im selben ordner wie meine excel datei.
ich möchte eine vorgangsnummer eingeben z..b 09-0100-01 und diese soll er mir dann in meiner terminliste suchen blatt
(Eingabe Termine) und von Spalte A:R kopieren. die zeilen sind immer anders aber die vorgangsnummer steht immer in Spalte B5:B1504
einfügen soll er mir sie in Tabelle1 von Spalte A15:R15 meine Excel tabelle heist Werkstatt.
wenn er fertig ist soll er die terminliste wo er die daten herr hat wieder schließen.
danke schon mal für deine hilfe .....!!!!!!!!!!!!!!!!

Hallo Nero,
wenn ich deine Angaben richtig verstanden habe dann sollte so funktionieren: Suchen

Gruß
fedjo

Hallo fedjo !!!
Danke schon mal für deine mühe !!!!sehr nett von dir.

aber leider klapt es noch nicht so richtig,
also die excel datein liegen im ordner Termine .
1) excel datei name ( Terminliste )
2) excel datei name ( Werkstatt )

jetzt öffne ich die datei namens Werkstatt.xls aus dieser datei möchte ich die suchanfrage starten.

gesucht werden soll in Terminliste.xls ( Tabelle 1 ) B5 bis B1504
wen er den wert ( z.b.09-0100-01 ) gefunden hat soll er mir die werte von Spalte A bis R der jeweiligen zeile kopieren wo er auch
z.b.09-0100-01 gefunden hat.
diese werte soll er mir dan in die exceldatei namens Werkstatt
Tabelle1 von Spalte A15:R15 einfügen.
zum schluß soll er die excel tabelle Terminliste.xls wieder schließen.

Danke schon mal für deine mühe ...!
gruß nero

Hallo Nero,
was funktioniert genau genommen nicht?

Gruß
fedjo

hallo erst ein mall..!
also ich habe die datei in meinen ordner terminliste gespeichert,
dann habe ich das makro gestartet und z.b 09-0100-01 eingegeben.
diese nummer ist auch in der anderen datei vorhanden.
dan hat er mir ab zeile A15 volgendes geschrieben.
1,09-0100-01,2,3,4,5,6,7,8,9,10...,17
dan habe ich es noch mal versucht und dann kamm
A,09-0100-01,B,C,D,....., bis Q
als nächstes habe ich mal nichts eingegeben dan hat er mir eine neue mappe mit nahmen werkstatt erstelt...??
woran kann das liegen..?
gruß nero

Hallo Nero,
habe ich da was falsch verstanden, soll nach einem Fund dann nicht die ganze Zeile von A - R übertragen werden?

Gruß
fedjo

Hallo,
doch das soll sie,aber in meinen zeilen von A bis R stehen werte...
z.b bei 09-0100-01

A B C D E .......R
5 09-0100-01 Bauforhaben Kunde Stück Anlieferung

und diese werte werden irgend wie nicht kopiert und in meiner datei eingetragen...!

geruß nero

Hi,

Ja fedjo, Du hast etwas falsch verstanden bzw. wohl eher überlesen. Nero erwartet die Werte aus einem anderen Workbook/ einer anderen Datei. (Zumindest lese ich so seine A4.) Du aber suchst in einem anderen (hidden) Sheet im gleich Workbook.

Bye

Hallo,kann mir vieleicht jemand helfen wäre sehr nett von euch...!

gruß nero022

hi all ^^

ein ansatz

gruss nighty

ausgehend davon das die gesuchten nummern einmalig vorhanden sind

anpassung des dateinamens,der zu oeffnenden datei

Worksheets(1).Range("A1") dient der eingabe einer zahl.
die dann gesucht wird in einer datei die geoeffnet wird und zur zeit in spalte a die zahl sucht und den danebenliegenden wert bzw spalte b kopiert nach
ThisWorkbook.Worksheets(1).Range("A5")

Option Explicit
Sub DateiLesen()
    Dim DateiName As String
    Dim Suche As Range
    DateiName = "DeinDateiName.xls"
    Workbooks.Open Filename:="C:\Temp\" & DateiName
    Set Suche = Workbooks(DateiName).Worksheets(1).Range("A1:A" & Workbooks(DateiName).Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find(ThisWorkbook.Worksheets(1).Range("A1"))
    If Not Suche Is Nothing Then
        ThisWorkbook.Worksheets(1).Range("A5") = Workbooks(DateiName).Worksheets(1).Cells(Suche.Row, Suche.Column + 1)
    End If
    Workbooks(DateiName).Close
End Sub

hi all ^^

sollten es mehrere zeilen sein
so ware der autofilter eine variante,gefilterte daten kopieren/einfuegen

gruss nighty

Hallo Nero,
konnte mich aus beruflichen Gründen länger nicht melden.

Code in ein Modul der Datei "Werkstatt" einfügen.
Pfad der Terminliste ändern.

Option Explicit
Sub Start()
Application.ScreenUpdating = False
ChDir "C:\Dokumente und Einstellungen\Admin\Desktop"
Workbooks.Open Filename:="C:\Dokumente und Einstellungen\Admin\Desktop\Terminliste.xls"
Workbooks("Terminliste.xls").Sheets("Tabelle1").Activate
Application.Run "Terminliste.xls!Tabelle1.Suchen"
Workbooks("Terminliste.xls").Close
End Sub

Code in das Codefenster der Tabelle1 der Datei "Terminliste" einfügen.

Option Explicit
Sub Suchen()
Application.ScreenUpdating = False
Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Sheets("Tabelle1").Range("B5:B" & Range("B1504").End(xlUp).Row)
With rngBer
strSuch = InputBox("Suchen nach:", "Suchen in Spalte: B")
If strSuch = "" Then
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
MsgBox "Eintrag nicht vorhanden"
Else
firstAddress = c.Address
Do
c.Activate
Loop While Not c Is Nothing And c.Address <> firstAddress

Sheets("Tabelle1").Range(ActiveCell.Offset(0, 16), ActiveCell.Offset(0, -1)).Copy Workbooks("Werkstatt.xls").Sheets("Tabelle1").Range("A15")
End If
End With
Workbooks("Terminliste.xls").Close
End Sub

Mustertabellen:
Auch hier Pfadangaben "Terminliste" ändern.
Werkstatt


Terminliste

Gruß
fedjo

Hallo fedjo , danke für deine Hilfe !!!!
habe den code in meinen tabelle kopiert,es klapt auch so weit ganz gut.
auser das er mir einen fehler anzeigt...!

Index außerhalb des gültigen Bereichs (Fehler 9)
bei: Workbooks("Terminliste.xls").Close

Sub Start()
Application.ScreenUpdating = False
ChDir "I:\Terminliste"
Workbooks.Open Filename:="I:\Terminliste\Terminliste_neu.xls"
Workbooks("Terminliste_neu.xls").Sheets("Tabelle1").Activate
Application.Run "Terminliste_neu.xls!Tabelle1.Suchen"
Workbooks("Terminliste_neu.xls").Close
End Sub


Woran kann das wohl liegen...
Danke noch mal !!

Hallo Nero,
Code in der Datei Terminliste ersetzen:
Option Explicit
Sub Suchen()
Application.ScreenUpdating = False
Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Sheets("Tabelle1").Range("B5:B" & Range("B1504").End(xlUp).Row)
With rngBer
strSuch = InputBox("Suchen nach:", "Suchen in Spalte: B")
If strSuch = "" Then
Workbooks("Terminliste.xls").Close ' neu eingefügt
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
MsgBox "Eintrag nicht vorhanden"
Else
firstAddress = c.Address
Do
c.Activate
Loop While Not c Is Nothing And c.Address <> firstAddress
Sheets("Tabelle1").Range(ActiveCell.Offset(0, 16), ActiveCell.Offset(0, -1)).Copy Workbooks("Werkstatt.xls").Sheets("Tabelle1").Range("A15")
End If
End With
Workbooks("Terminliste.xls").Close
End Sub

Im Makro Start die Zeile löschen:
Workbooks("Terminliste_neu.xls").Close

Gruß
fedjo

Hallo fedjo !!!
danke noch mal es hat geklaptt super !!!!
eine frage habe ich da noch,ist es möglich die abfrage ob er meine terminliste speichern soll ja/nein weg zulassen ...?
also das er einfach die terminliste schließt ohne speichern...?!
wen nicht ist auch ok
du hast mir schon sehr weiter geholfen !!!!!!!!!!!!!!!
gruß nero

Hallo Nero
beim Makro "Suchen" gleich am Anfang des Codes einfügen:
Application.DisplayAlerts = False

Am Ende des Codes einfügen
Application.DisplayAlerts = True

Alle Meldungen werden dadurch unterdrückt und wieder aktiviert.

Gruß
fedjo

Hallo fedjo,
habe die beiden sachen bei suchen hinzugefügt,
dan sagt mir excel auf einmal wen ich das suchen ausführe,
das excel ein fehler hat und beendet werden muß...?

gruß nero.

Option Explicit
Sub Suchen()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Sheets("Eingabe Termine").Range("B5:B" & Range("B1504").End(xlUp).Row)
With rngBer
strSuch = InputBox("Suchen nach:", "Suchen in Spalte: B")
If strSuch = "" Then
Workbooks("Terminliste_neu.xls").Close ' neu eingefügt
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
MsgBox "Eintrag nicht vorhanden"
Else
firstAddress = c.Address
Do
c.Activate
Loop While Not c Is Nothing And c.Address <> firstAddress
Sheets("Eingabe Termine").Range(ActiveCell.Offset(0, 16), ActiveCell.Offset(0, -1)).Copy Workbooks("Werkstatt.xls").Sheets("Tabelle1").Range("A15")
End If
End With
Workbooks("Terminliste_neu.xls").Close
Application.DisplayAlerts = True
End Sub

Hallo Nero,
welche Excel Version verwendest du?

Gruß
fedjo

Hallo Nero,
versuchs mal so:

Option Explicit
Sub Suchen()
Application.ScreenUpdating = False
Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Sheets("Tabelle1").Range("B5:B" & Range("B1504").End(xlUp).Row)
With rngBer
strSuch = InputBox("Suchen nach:", "Suchen in Spalte: B")
If strSuch = "" Then
Workbooks("Terminliste.xls").Close
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
MsgBox "Eintrag nicht vorhanden"
Else
firstAddress = c.Address
Do
c.Activate
Loop While Not c Is Nothing And c.Address <> firstAddress
Sheets("Tabelle1").Range(ActiveCell.Offset(0, 16), ActiveCell.Offset(0, -1)).Copy Workbooks("Werkstatt.xls").Sheets("Tabelle1").Range("A15")
End If
End With
Workbooks("Terminliste.xls").Close SaveChanges:=False
End Sub

Gruß
fedjo