Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1072to1076
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Werte aus Mappe1 in Mappe2 übernehmen

Werte aus Mappe1 in Mappe2 übernehmen
Jubro
Hallo zusammen,
ich suche ein Lösung für folgendes:
In Mappe1/Tabelle1 soll per ButtonClick die Zeile4 komplett ausgewählt und kopiert dann in Mappe2/Tabelle1 die Werte (kopierte Inhalte) eingefügt werden.
Das Komplizierte daran ist:
die zu kopierende Zeile4 aus Mappe1/Tabelle1 beginnt in Spalte A mit einer Nummer (zB. 1234), diese Nummer findet sich auch in Mappe2/Tabelle1/Spalte A jedoch muss die Zeile vorher gesucht werden bevor man die Inhalte einfügen kann!!!
Ich habe sehr wenig Ahnung von VB und habs schon mit Macroaufzeichnung versuch, aber da ist ja dann die Zeile in die ich die Werte einfüge nicht variabel
Gruß Jubro
AW: Werte aus Mappe1 in Mappe2 übernehmen
Tino
Hallo,
versuche es mal hiermit.
Beide Dateien müssen in der gleichen Instanz geöffnet sein.
Sub Beispiel()
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Dim LRow

'wo die Daten herkommen, Quelle 
Set Quelle = Workbooks("Mappe1.xls").Sheets("Tabelle1")
'wo die Daten hin sollen, Ziel 
Set Ziel = Workbooks("Mappe2.xls").Sheets("Tabelle1")

LRow = Application.Match(Quelle.Cells(4, 1), Ziel.Columns(1), 0)

If IsNumeric(LRow) Then 'prüfen ob nummer gefunden 
 Quelle.Rows(4).Copy Ziel.Rows(LRow)
Else
 MsgBox "Die Numme " & Quelle.Cells(4, 1) & " wurde nicht gefunden!"
End If



End Sub


Gruß Tino

Anzeige
AW: Werte aus Mappe1 in Mappe2 übernehmen
Jubro
Hallo Tino,
habs grad gleich mal su versucht, es fuktioniert nur zum Teil und es sind auch nicht nur Werte sondern auch Bezüge mitkopiert worden die nicht mehr stimmen.
Gruß Jubro
AW: Werte aus Mappe1 in Mappe2 übernehmen
Tino
Hallo,
nur die Werte, versuche es so.
Sub Beispiel()
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Dim LRow

'wo die Daten herkommen, Quelle 
Set Quelle = Workbooks("Mappe1.xls").Sheets("Tabelle1")
'wo die Daten hin sollen, Ziel 
Set Ziel = Workbooks("Mappe2.xls").Sheets("Tabelle1")

LRow = Application.Match(Quelle.Cells(4, 1), Ziel.Columns(1), 0)

If IsNumeric(LRow) Then 'prüfen ob nummer gefunden 
 Quelle.Rows(4).Copy
 Ziel.Rows(LRow).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
Else
 MsgBox "Die Numme " & Quelle.Cells(4, 1) & " wurde nicht gefunden!"
End If



End Sub


Gruß Tino

Anzeige
AW: Werte aus Mappe1 in Mappe2 übernehmen
Jubro
Hi Tino,
vielen Dank, gleich getestet, es funtzt!!!
Gracias
Gruß Jubro
AW: Werte aus Mappe1 in Mappe2 übernehmen
Jubro
Hallo zusammen,
noch eine Frage zu Tino´s Lösung (die ja auch funktioniert) !
Wenn ich jetzt Mappe1 unter anderem Namen abspeichere (das kommt bei dem was ich vorhabe ständig vor und dann auch unter ständig anderen Namen), funktioniert ja die Werteübernahme nicht mehr da der Name Mappe1 fest verdrahtet ist!
Wie kann man dies Variabel machen? in der Art wie:
Set Quelle = Workbooks("Workbooks.Name").Sheets("Tabelle1") oder so!
Gruß Jubro
AW: Werte aus Mappe1 in Mappe2 übernehmen
Tino
Hallo,
wenn Du die Quelle immer zuerst öffnest, könnte es so gehen.
Set Quelle = Workbooks(1).Sheets("Tabelle1")
Sonst fällt mir nichts ein, wie die unbekannte Quelle bestimmt werden könnte.
Gruß Tino
Anzeige
AW: Werte aus Mappe1 in Mappe2 übernehmen
Jubro
Hallo,
habs mal so versucht aber es klappt nicht.
Kennt sonst vielleich jemand eine Möglichkeit den Dateinamen als Variable abzufragen?
Gruß Jubro
AW: Werte aus Mappe1 in Mappe2 übernehmen
Tino
Hallo,
wenn es beio mir funzt müsste es auch bei Dir gehen.
Sub Beispiel()
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Dim LRow

'wo die Daten herkommen, Quelle 
Set Quelle = Workbooks(1).Sheets("Tabelle1")

'wo die Daten hin sollen, Ziel 
Set Ziel = Workbooks("Mappe2.xls").Sheets("Tabelle1")

''oder auch so 
'Set Ziel = Workbooks(2).Sheets("Tabelle1") 

LRow = Application.Match(Quelle.Cells(4, 1), Ziel.Columns(1), 0)

If IsNumeric(LRow) Then 'prüfen ob nummer gefunden 
 Quelle.Rows(4).Copy
 Ziel.Rows(LRow).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
Else
 MsgBox "Die Numme " & Quelle.Cells(4, 1) & " wurde nicht gefunden!"
End If



End Sub


Wie schon geschrieben, die Quelle muss als erste Datei geöffnet werden!
Gruß Tino

Anzeige
AW: Werte aus Mappe1 in Mappe2 übernehmen
Jubro
Hallo,
sorry, bei mir kommt immer Laufzeitfehler 9
Index ausserhalb des gültigen Bereiches.
Wo liegt der Fehler

Private Sub CommandButton1_Click()
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Dim LRow
'wo die Daten herkommen, Quelle
'Set Quelle = Workbooks("Kalkland.xls").Sheets("Datenlink")
Set Quelle = Workbooks(1).Sheets("Datenlink")
'wo die Daten hin sollen, Ziel
Set Ziel = Workbooks("Angebotsnummern.xls").Sheets("Tabelle1")
LRow = Application.Match(Quelle.Cells(4, 1), Ziel.Columns(1), 0)
If IsNumeric(LRow) Then 'prüfen ob nummer gefunden
Quelle.Rows(4).Copy
Ziel.Rows(LRow).PasteSpecial xlPasteValues
MsgBox "Das Angebot mit der Nummer " & Quelle.Cells(4, 1) & " wurde in Angebotsübersicht  _
eingetragen!", vbInformation, "Kalkland Meldung"
Application.CutCopyMode = False
Else
MsgBox "Die Angebotsnummer " & Quelle.Cells(4, 1) & " ist in der Angebotsübersicht nicht  _
vorhanden!", vbCritical, "Kalkland Meldung"
End If
End Sub


Gruß Jubro

Anzeige
in welcher Zeile? oT.
Tino
oder auch so.
Tino
Hallo,
Du könntest es auch mal so versuchen, nun ist es egal welche Datei zuerst offen ist.
Private Sub CommandButton1_Click()
 Dim myWB As Workbook
 Dim Quelle As Worksheet
 Dim Ziel As Worksheet
 Dim LRow
 
 'prüfen welche Datei nicht Angebotsnummern.xls ist 
 For Each myWB In Workbooks
  If myWB.Name <> "Angebotsnummern.xls" Then Exit For
 Next myWB
 
 'wo die Daten herkommen, Quelle 
 'Set Quelle = Workbooks("Kalkland.xls").Sheets("Datenlink") 
  Set Quelle = myWB.Sheets("Datenlink")
  
 'wo die Daten hin sollen, Ziel 
 Set Ziel = Workbooks("Angebotsnummern.xls").Sheets("Tabelle1")
 
 LRow = Application.Match(Quelle.Cells(4, 1), Ziel.Columns(1), 0)
 
 If IsNumeric(LRow) Then 'prüfen ob nummer gefunden 
  Quelle.Rows(4).Copy
  Ziel.Rows(LRow).PasteSpecial xlPasteValues
  MsgBox "Das Angebot mit der Nummer " & Quelle.Cells(4, 1) & " wurde in Angebotsübersicht eingetragen!", vbInformation, "Kalkland Meldung"
  
  Application.CutCopyMode = False
 Else
  MsgBox "Die Angebotsnummer " & Quelle.Cells(4, 1) & " ist in der Angebotsübersicht nicht vorhanden!", vbCritical, "Kalkland Meldung"
 End If
 
 End Sub


Gruß Tino

Anzeige
AW: oder auch so.
Jubro
Hallo Tino,
ich hab deinen Vorschlag 1zu1 reinkopiert und nichts daran geändert.
Ich bekomm aber immernoch den Laufzeitfehler 9 mit dem Index ausserhalb des gültigen Bereich.
Danke für deine Hilfe.
Gruß Jubro
AW: oder auch so.
Tino
Hallo,
gibt es die Tabelle mit dem Namen Datenlink in der Quelldatei?
Heißt die Zieldatei Angebotsnummern.xls?
Gibt es die Tabelle1 in der Zieldatei?
Sind beide Dateien in der gleichen Excel Instanz geöffnet?
In welcher Zeile bekommst Du den Fehler?
Gruß Tino
AW: oder auch so.
Jubro
Hallo Tino,
jetzt hab ich den Fehler, ich bin jetzt Zuhause und da funtz aber da arbeite ich mit Excel 2000 und bei der Arbeit hab ich excel 2003! Sorry ;o)
Kann man die Lösung die du mir als letztes gegeben hast auch auf 2003 zum laufen bringen? denn da brauch ichs ja nachher auch.
Die Namen Datenlink in der Quelldatei und die Zieldatei Angebotsnummer.xls mit Tabelle1 sind korrekt.
Gruß Jubro
Anzeige
AW: oder auch so.
Tino
Hallo,
dieser Code läuft bei Dir unter xl2000, bei mir unter xl2003 u. xl2007.
Schau nochmal genau nach, irgendetwas da stimmt nicht.
Eine Frage hast Du noch immer nicht beantwortet, in welcher Zeile kommt der Fehler?
Gruß Tino
AW: oder auch so.
Jubro
Hallo,
der Fehler kommt in der Zeile:
Set Quelle = myWB.Sheets("Datenlink")
aber wie gesagt hier Zuhause unter xl2000 gehts.
ich hab Zuhaus leider nicht die Möglichkeit es xl2003 od. xl2007 zu testen.
Komisch *grübel*
Gruß Jubro
AW: oder auch so.
Tino
Hallo,
wenn die Tabelle wirklich "Datenlink" heißt,
keine Leerzeichen die auf den ersten Blick nicht zu erkennen sind oder sowas drin ist, muss es gehen.
Oder irgendetwas stimmt mit Deiner Datei nicht, eventuell teste mal mit einer neuen Datei testen.
Gruß Tino
Anzeige
AW: oder auch so.
Jubro
Hallo,
ok,ich werds am Montag bei der Arbeit nochmals probieren.
Wenn wir gerade so schön beieinander sind! frage ich dich gleich mal was zu meinem nächsten Fall
Ich hab mehrere Checkboxen siehe hier:

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
Range("A3:C9").Select
End If
End Sub



Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
Range("A12:C20").Select
End If
End Sub



Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
Range("A23:C31").Select
End If
End Sub


Wie du siehst markieren die mir verschiedene Bereiche. Jedoch tun sie das nur für die jeweilige Auswah.
Das heißt: wen ich Box 1 anclicke markiert er mir die zugehörigen Zellen wenn ich aber nun Box 2 anklicke sind die durch Box 1 markierten Zellen eben nicht mehr markiert.
Ich will damit eine Auswahl erstellen welche Bereiche dann bei Click auf einen Button ausgedruckt werden sollen.
Gruß Jubro

Anzeige
AW: oder auch so.
Tino
Hallo,
versuche es mal so.
Option Explicit

Private Sub CheckBox1_Click()
 Call SelectCheckBox
End Sub

Private Sub CheckBox2_Click()
 Call SelectCheckBox
End Sub

Private Sub CheckBox3_Click()
 Call SelectCheckBox
End Sub

Private Sub SelectCheckBox()
Dim Bereich As Range
  
  If CheckBox1.Value = True Then Set Bereich = Range("A3:C9")
  
  If CheckBox2.Value = True Then
    If Not Bereich Is Nothing Then
     Set Bereich = Union(Bereich, Range("A12:C20"))
    Else
     Set Bereich = Range("A12:C20")
    End If
  End If
  
  If CheckBox3.Value = True Then
    If Not Bereich Is Nothing Then
     Set Bereich = Union(Bereich, Range("A23:C31"))
    Else
     Set Bereich = Range("A23:C31")
    End If
  End If
  
  If Not Bereich Is Nothing Then
   Bereich.Select
  End If

End Sub


Gruß Tino

AW: oder auch so.
Jubro
Hallo,
danke! funzt! und wie drucke ich jetzt das selectierte aus?
Range.Select.PrintOut oder so?
Sorry ich hab echt so wenig Ahnung von VB und muss halt für die Arbeit was Lösen wobei mir da keiner helfen kann!
Gruß Jubro
Ich hab auch schon gedacht ich machs vielleicht auf ne einfachere Art wie:

Private Sub CommandButton1_Click()
'druckt Datenblatt 1
Range("Datenblatt").PrintOut Copies:=1
End Sub



Private Sub CommandButton2_Click()
'druckt Datenblatt 2
Range("Angebot").PrintOut Copies:=1
End Sub



Private Sub CommandButton3_Click()
'drukt Datenblatt 3
Range("Transportkosten").PrintOut Copies:=1
End Sub


usw.

AW: oder auch so.
Tino
Hallo,
Druckbereich festlegen und drucken, dies mit dem Rekorder aufzeichnen.
Gruß Tino
AW: oder auch so.
Jubro
Hallo Tino,
danke du hast mir heut sehr viel weitergeholfen
Gruß Jubro
AW: oder auch so.
Jubro
Hallo Tino
jetzt hab ich nochmals nachgeschaut! bei der Arbeit habe ich xl2003 da funtz nich und daheim hab ich xl200 da funtz:
Es kommt unter xl2003:
Laufzeitfehler '9': Index ausserhalb des gültigen Bereich
Beim debuggen ist die Zeile Set Quelle = myWB.Sheets("Datenlink")
Wenn ich den Kommentar
'Set Quelle = Workbooks("Kalkland.xls").Sheets("Datenlink")
wieder scharf mache
und
Set Quelle = myWB.Sheets("Datenlink") gelb markiert.
auskommentier tuts ja.

Private Sub CommandButton1_Click()
Dim myWB As Workbook
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Dim LRow
'prüfen welche Datei nicht Angebotsnummern.xls ist
For Each myWB In Workbooks
If myWB.Name  "Angebotsnummern.xls" Then Exit For
Next myWB
'wo die Daten herkommen, Quelle
'Set Quelle = Workbooks("Kalkland.xls").Sheets("Datenlink")
Set Quelle = myWB.Sheets("Datenlink")
'wo die Daten hin sollen, Ziel
Set Ziel = Workbooks("Angebotsnummern.xls").Sheets("Tabelle1")
LRow = Application.Match(Quelle.Cells(4, 1), Ziel.Columns(1), 0)
If IsNumeric(LRow) Then 'prüfen ob nummer gefunden
Quelle.Rows(4).Copy
Ziel.Rows(LRow).PasteSpecial xlPasteValues
MsgBox "Das Angebot mit der Nummer " & Quelle.Cells(4, 1) & " wurde in Angebotsübersicht  _
eingetragen!", vbInformation, "Kalkland Meldung"
Application.CutCopyMode = False
Else
MsgBox "Die Angebotsnummer " & Quelle.Cells(4, 1) & " ist in der Angebotsübersicht nicht  _
vorhanden!", vbCritical, "Kalkland Meldung"
End If
End Sub


Gruß Jubro

AW: oder auch so.
Jubro
AW: oder auch so.
Tino
Hallo,
mach mal nach der Schleife eine Msg Box um zu sehen ob es auch die richtige Datei (Quelle) ist.

'prüfen welche Datei nicht Angebotsnummern.xls ist
For Each myWB In Workbooks
If myWB.Name  "Angebotsnummern.xls" Then Exit For
Next myWB
MsgBox myWB.Name


Gruß Tino

AW: oder auch so.
Jubro
Hi,
hab ich jetzt Zuhaus (xl2000) gemacht und er zeit den korrekte Dateinamen an (Kalkland.xls).
Hab die Datei umbenannt und es stimmt auch (123test.xls).
Ich werds dann morgen auch nochmal bei der Arbeit testen unter xl2003
Gruß Jubro
AW: oder auch so.
Jubro
Hallo
ich hab mir jetz Zuhaus auch xl2003 draufgespielt und siehe da es funzt (xl2003 Build 11.5612.5606)
jetzt hol ich mir gerade den Sp3 von microsoft inst. den auch und dann bin ich mal gespannt.
Welchen Build ich bei der Arbeit hab weiß ich net auswendig, das werd ich morgen gleich mal nachschaun.
Gruß Jubro
AW: oder auch so.
Jubro
so, und jetzt hab ich Build 11.8169.8172 SP3 drauf und es funzt immernoch.
Gruß Jubro
AW: oder auch so.
Jubro
Hallo Tino,
bei der Arbeit gibt mir die zusätzlich eingebundene MsgBox eine andere datei aus "Personl.xls" aus. Die ist ja ansonsten immer ausgeblendet deswegen denk ich an die nie. Also doch kein xl2003 Fehler aber.
Kannst man dies Problem lösen indem man diese Datei irgendwie direkt ausschliesst, weil die heisst ja eh immer Personl.xls an jedem xl... System
Gruß Jubro
AW: oder auch so.
Tino
Hallo,
versuche es mal so.
Private Sub CommandButton1_Click()
    
Dim myWB As Workbook
 Dim Quelle As Worksheet
 Dim Ziel As Worksheet
 Dim LRow
 
 'prüfen welche Datei nicht Angebotsnummern.xls ist 
 For Each myWB In Workbooks
  If myWB.Name <> "Angebotsnummern.xls" And Not myWB.Name = "Personl.xls" Then Exit For
 Next myWB
 
 'wo die Daten herkommen, Quelle 
 'Set Quelle = Workbooks("Kalkland.xls").Sheets("Datenlink") 
  Set Quelle = myWB.Sheets("Datenlink")
  
 'wo die Daten hin sollen, Ziel 
 Set Ziel = Workbooks("Angebotsnummern.xls").Sheets("Tabelle1")
 
 LRow = Application.Match(Quelle.Cells(4, 1), Ziel.Columns(1), 0)
 
 If IsNumeric(LRow) Then 'prüfen ob nummer gefunden 
  Quelle.Rows(4).Copy
  Ziel.Rows(LRow).PasteSpecial xlPasteValues
  MsgBox "Das Angebot mit der Nummer " & Quelle.Cells(4, 1) & " wurde in Angebotsübersicht eingetragen!", _
  vbInformation, "Kalkland Meldung"
  
  Application.CutCopyMode = False
 Else
  MsgBox "Die Angebotsnummer " & Quelle.Cells(4, 1) & " ist in der Angebotsübersicht nicht vorhanden!", _
  vbCritical, "Kalkland Meldung"
 End If

End Sub


Gruß Tino

AW: oder auch so.
Jubro
Hallo,
jetzt tuts so weit das wenn vorher keine andere Mappe geöffnet wurde. Wenn die Mappe Kalkland aber neu geöffnet wird und eine andere Mappe geöffnet bleibt wird duch die Abfrage nicht mehr die Mappe Kalkland gefunden sondern es wird mir die andere Mappe in MsgBox angegeben obwohl die Mappe kalkland offen ist.
Ach ja und ich hab gemerk das Groß u. Kleinschreibung auch ne Rolle spiel. Es tat soweit erst als ich PERSONL.XLS geschrieben hab.
Gruß Jubro
AW: oder auch so.
Tino
Hallo,
es dürfen nur die zwei Dateien geöffnet sein, weil man sonst die unbekannte Datei ja nicht feststellen kann.
War so von Dir gewollt.
Zitat:
"Wenn ich jetzt Mappe1 unter anderem Namen abspeichere (das kommt bei dem was ich vorhabe ständig vor und dann auch unter ständig anderen Namen), funktioniert ja die Werteübernahme nicht mehr da der Name Mappe1 fest verdrahtet ist!"
Gruß Tino
AW: oder auch so.
Jubro
Hallo,
ich werd damit leben :o)), es tut ja jetzt.
Vielen Dank
Gruß Jubro

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige