Office: VBA - Zelleninhalt in anderen Mappe suchen und Zellen kopieren und in die 1. Mappe...

Hallo Liebe Excel User,

ich sitze hier vor Excel 2007 und bin stolz auf mich soweit gekommen zu sein, leider bin ich jetzt an einen Punkt angelangt wo mir meine Bücher und das Internet nicht weiter hilft.

Ich versuche mal zu erklären was ich erreichen will:
Durch eine erste Mappe-START wird die Mappe-Vorlage im Vordergrund geöffnet und im Hintergrund die Mappe-Preise (Geschützt vor Änderungen). Dabei wird aus Mappe-START die Eingabe des Username gleich in die Mappe-Vorlage kopiert (Zelle I3). Das läuft ohne Probleme.

Hier das was ich erreichen will...
Jetzt ist die Mappe-Vorlage offen und ich kann nur in Spalte B einen Code (z.B. 10,001 oder Ganzzahlen 0 - 9) eingeben, alle anderen Zellen sind Gesperrt und nicht auswählbar. Nach jeder Eingabe in der Spalte B soll er in der Mappe-Preise, die Tabelle "Username" (wo in Mappe-Vorlage in Zelle I3 steht) in Spalte A nach diesen Code suchen. Sollte der Code nicht auffindbar sein, sollte einfache Meldung kommen "Unbekannter Code" und die Zelle wieder leeren. Sollte der Code gefunden werden, dann sollen rechts davon 8 Zellinhalte kopiert werden und in die Mappe-Vorlage ab Spalte E eingefügt werden in der Zeile wo der Code steht, danach soll er dann in die nächste Zeile in Spalte B springen.

Kann mir da jemand helfen?
Kann man die Suche in der Mappe-Preise auch machen ohne das die Mappe in den Vordergrund springt?

Ich versuche in den nächsten paar Minuten mal den Code wo ich bisher habe hier einzufügen.

Bin für jede Hilfe sehr dankbar.

Gruß
Emi

___
Edit: Mein Code in dem ich nicht mehr weiter komme.
Sry, für die viele Kommentare, aber die helfen mir den Überblick wieder zu bekommen.
Der Code ist fehlerhaft, bin am Versuchen etwas zusammen zu bekommen.

Code:

'neuer Code weiter unten

 

Hallo Emi,
im Prinzip so:
'deklariere Objektvariable
Dim wbVorlage As Workbook
Dim wbPreise As Workbook
Dim sRange As Range
'setze ein Objekt auf die Variable
Set wbVorlage = Workbooks("Vorlage")
Set wbPreise = Workbooks("Preise")
'
Set sRange = wbPreise.Worksheets(strTabelle).Columns("A")
'jetzt kannst du z.B. mit FIND den sRange durchsuchen ohne dass die Worksheets(strTabelle) sichtbar wird.
'zur Laufzeit des Makros wird sie natürlich aktiv, aber nicht für dich auf dem Monitor.

 

Hallo Rudi,

danke für deine Mühe. Ich habe über Nacht nochmal von vorne Angefangen den oberen Code neu zu schreiben und bin etwas weiter gekommen. Naja, irgendwie sieht er jetzt etwas anderster aus.

Deinen Code verstehe ich eigentlich, aber ich schaffe mit FIND nur Datums zu finden, aber meine Codes nicht.

Außerdem schaffe ich es nicht das er mir in der Tabelle-Preise dann die 8 neben dran stehenden Zellen kopiert und in Tabelle-Vorlage in der selben Zeile ab der Spalte E wieder einfügt. Muss ich hier vielleicht Zelle für Zelle kopieren und dann einfügen? Denn ich versuche das er mir den Bereich makiert, kopiert und dann in der Datei mit der Tabelle-Vorlage das einfügt. Irgendwie klappt das nicht so, ehrlich gesagt bin ich gerade Gedankenlos...

Mach jetzt erst einmal eine Pause, vielleicht fällt mir noch etwas in die Finger was ich versuchen kann.

Muss ich da auf Formatierungen achten? ich meine ob ich es als Text, Zahl oder auf Standard stehen lasse, spielt das eine Rolle?

Ok, ich tipp den Code schnell ab und stell ihn in kürze wieder rein.

Gruss
Emi

Hier der Code:

bis hierher Funktioniert alles.

Mit deinem Lösungsansatz komm ich nicht weiter und auf meinem Weg werden die Zellen nicht gelb. Mir gibt er immer die Meldung von der MsgBox aus das er den Code nicht finden kann, aber ich hab mich zu 100% überzeugt das er in der Tabelle wo er sucht vorhanden ist. Eigentlich ist er in jeder Tabelle vorhanden. Beispiel für einen Code der überall drin steht ist: "12,012" muss ich da etwas beachten wegen der Formatierung?

Gruß Emi</info
</info
</info
</info

 

Hallo Emi, ist die Reihenfolge /Ablauf nachvollziehbar?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
' Dim strCode As String strCode = Target
 Dim strMenge As String
 Dim strTabelle As String
 Dim wbPreise As Workbook
 Dim strWert As String
 Dim z As Long
'wenn eine Zelle in Spalte B verändert wurde
If Not Application.Intersect(Target, Range("B2:B1000")) Is Nothing Then
  'Ereignisbehandlung abschalten
  Application.EnableEvents = False
  'Fehlerbehandlung einschalten
  On Error GoTo errorhandler
  'wenn Target nicht leer ist
  If Len(Target.Value) Then
    'Text in Variable übernehmen
    strTabelle = ActiveSheet.Range("L3").Text
    'wenn in dieser tabelle in L3 ein Wert vorhanden ist
    If Len(strTabelle) Then
      'Verweis auf Objekt im Hintergrund
      With Workbooks("Preise.xlsx").Worksheets(strTabelle)
       'Suche mit Schleife ab Zeile 2 in Spalte 1
        For z = 2 To .UsedRange.Rows.Count
           '1. Übereinstimmung
           If .Cells(z, 1) = Target Then
              '8 Zellen rechts von Fundstelle kopieren
              .Range(.Cells(z, 2), .Cells(z, 9)).Copy Me.Cells(Target.Row, 5)
              Exit For
           End If
        Next
      End With
    Else
      MsgBox "Es ist kein User genannt!!!" & vbCrLf & vbCrLf _
        & "Bitte mit 'START.xlsm' beginnen!!!"
    End If
  End If
End If
 
errorhandler:
Application.EnableEvents = True
End Sub

 

Hallo Rudi,

ich werde mir das mal über das Wochenende anschauen, heute werde ich leider keine große Zeit dafür haben.
Sollte mir etwas nicht klar sein oder es nicht so klappen sollen, werde ich mir die Datei doch mal kopieren und hier mal reinsetzen.
Ich weiß das es viel einfacher ist wenn die Datei vorliegt als zu versuchen es irgendwie zu verstehen.

Ich werde mich auf jeden Fall melden. Vielen Dank für deine Hilfe und ein schönes Wochenende.

Gruß
Emi

 

Hallo und einen schönen Gruss & Dank an Rudi,

ich bin erstaunt wie gut dein Code funtioniert, aber eine Frage habe ich noch. Die Preisliste ist farblich hinterlegt um zu sehen zur welcher Gruppe es angehört. Beim Copy kopiert er den Rahmen und die Zellfarbe mit. Kann man die Kopierfunktion nicht irgendwie anpassen das er nur den Zellinhalt kopiert und dann einfügt?

Ich bin bisher nicht dahinter gekommen, meine jetziger Lösungsversuch ist nach jedem Kopieren das er die Hintergrundfarbe rausnimmt, was vorerst klappte. Nur mit dem Rahmen hab ich Probleme...

Mir wäre die erste Idee lieber falls es machbar wäre nur die Inhalte der Zellen zu kopieren.

Nochmals vielen Dank.

Gruß
Emi

 

mit PasteSpecial

Hallo Emi,

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim strMenge As String
 Dim strTabelle As String
 Dim wbPreise As Workbook
 Dim strWert As String
 Dim z As Long
'wenn eine Zelle in Spalte B verändert wurde
If Not Application.Intersect(Target, Range("B2:B1000")) Is Nothing Then
  'Ereignisbehandlung abschalten
  Application.EnableEvents = False
  'Fehlerbehandlung einschalten
  On Error GoTo errorhandler
  'wenn Target nicht leer ist
  If Len(Target.Value) Then
    'Text in Variable übernehmen
    strTabelle = ActiveSheet.Range("L3").Text
    'wenn in dieser tabelle in L3 ein Wert vorhanden ist
    If Len(strTabelle) Then
      'Verweis auf Objekt im Hintergrund
      With Workbooks("Preise.xlsx").Worksheets(strTabelle)
       'Suche mit Schleife ab Zeile 2 in Spalte 1
        For z = 2 To .UsedRange.Rows.Count
           '1. Übereinstimmung
           If .Cells(z, 1) = Target.Value Then
              '8 Zellen rechts von Fundstelle kopieren (nur Werte)
              .Range(.Cells(z, 2), .Cells(z, 9)).Copy
              Me.Cells(Target.Row, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
              Exit For
           End If
        Next
      End With
    Else
      MsgBox "Es ist kein User genannt!!!" & vbCrLf & vbCrLf _
        & "Bitte mit 'START.xlsm' beginnen!!!"
    End If
  End If
End If
 
errorhandler:
Application.EnableEvents = True
End Sub

 

Vielen Dank Rudi,

du hast mir sehr viel geholfen, denke allein wäre ich noch nicht fertig, geschweige ob das ganze so kurz wäre.
Nochmals Vielen Dank!

Gruß
Emi

 

Hi,

ich habe jetzt entdeckt das ich an 4 Punkte nicht mitgedacht habe...
...und mittlerweile selber alle 4 Punkte davon lösen konnte. Habe meine Lösung alle genannt, für Verbesserungen einfach melden, freue mich immer etwas neues zu lernen. Danke nochmal an Rudi, hierbei habe ich einiges gelernt.

1. Erledigt - habe ich das er nach dem Kopieren eine Spalte nach links springt, anstatt durch das Enter eine Zeile weiter.
-habe im Code vor 'Exit For' einfach 'Me.Cells(Target.Row, 3).Select' hinzugefügt. Einfach war es nicht gerade, habe lange grübeln müssen. Vor allem weiß ich immer noch nicht was das 'Me' vor Cells zu bedeuten hat.

2. Erledigt - Nach dem Kopieren soll er in der Zelle rechts davon, also wo er jetzt hinspringt, diese neue Eingabe dann 7 Zellen rechts davon einfügen. Bisher war in der Zelle '=C3' usw. je Zeile gestanden. Jetzt wird es mit der Kopie überschrieben und ich denke das man dies doch per VBA machen sollte, aber ich bekomme dies nicht hin. Und weiterspringen in die nächste Zeile in Spalte B.

Code:

'Das hier habe ich vor dem Errorhandler: eingefügt.
If Not Application.Intersect (Target, Range("C6:C1000")) Is Nothing Then
   Application.EnableEvents = False
   On Error GoTo errorhandler
   If Len(Target.Value) Then
      Me.Cells(Target.Row, 3).Copy
      Me.Cells(Target.Row, 10).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
      Me.Cells(Target.Row + 1, 2).Select '>>ZU NR. 3<<
   End if
End if

3. Erledigt - Kann man VBA sagen das er eine Formel in eine Zelle einfügt? z.B. die Aktuelle Zeile wo gerade Werte kopiert wurden, in Spalte M soll diese Formel stehen '=Jx * Lx' wobei x die aktuelle Zeile ist. Ich schaffe es nur das es als Text dasteht...

Code:

'vor der Lösung von Punkt 1 folgendes eingefügt
Me.Cells(Target.Row, 13).FormulaLocal = "=J" & Target.Row & "*L" Target.Row

Ein sehr nützliches Ding!

4. Erledigt - Nach der Eingabe des Code's und Enter kopiert das Programm das richtige in die richtige Stelle hin, aber wenn man den Code wieder löscht und Enter drückt verschwindet nicht der Kopierter Teil. Leider habe ich hierzu keinen Ansatz gefunden wie ich da überhaupt anfangen soll. Gerade eben Fällt mir ein das ich in der Tabelle 'Preise' vielleicht eine Leere Zeile einfüge, vielleicht wird dann die leere Zeile eingefügt...

ich habe einfach bei Eingabe 0 den Befehl gegeben das er den Bereich auswählt und mit ".ClearContents" alles löscht. Einziges Problem darin ist das man immer dran denken muss und eine 0 eingibt, anstatt nur das Feld zu löschen. Sollte jemand einen direkten Weg kennen, dann bin ich für Vorschläge dankbar.

bin mal gespannt ob ich noch was übersehen habe. Als Anfänger im VBA bin ich auf Hilfe angewiesen. Ich bräuchte täglich etwas Zeit um mich damit beschäftigen zu können. Um so mehr bin ich am staunen wenn ich den erhaltenen Code anschaue und Teile davon sehe die mir völlig neu sind.

Gruß
Emi

P.S.: Für mich scheint es sich zu lohnen heute mit VBA sich zu beschäftigen oder ich habe langsam den Bogen raus.

 

Hallo Emi,
'sehe eben erst, dass es noch weiter geht.
Wenn ich dich richtig verstanden habe, dann sollen die zuvor copierten Werte wieder gelöscht werden.
Du hast doch im Code die If-Abfrage:

Code:

....
'wenn Target nicht leer ist
  If Len(Target.Value) Then
  ......>Restcode
   Else
      Me.Cells(Target.Row, 5).Resize(, 5).Value = ""
  End If
....

Füge einfach eine Else-Anweisung hinzu und trage in die Zellen NICHTS ein

 

Hi Rudi,

freut mich wieder etwas von dir zu hören. Meine Lösung funktioniert bisher ohne Probleme, aber ist nicht so kurz und einfach.
Sobald ich etwas Zeit finde werde ich es mal testen und eine Meldung hier posten.

Mittlerweile ab ich eine Erweiterung, aufgebaut auf das hier, aber dazu werde ich ein extra Thema öffnen.
Hoffe sehr wieder etwas von dir zu hören.

Nochmal's vielen Dank für deine Hilfe und Zeit.

Gruß
Emi

___ Meldung
Also es funktioniert bestens, ich hab es auf 9 Zellen erweitert und deine Lösung übernommen, weil es einfach einfach und kurz ist.

Danke