Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1056to1060
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

Daten in Mappe mit anderem Bereich übertragen

Daten in Mappe mit anderem Bereich übertragen
11.03.2009 21:09:11
Dietmar
Hallo zusammen!
Ich bin auf der Suche nach einem Makro, die (z.B.) Artikelnummern in zwei unterschiedlichen Arbeitsblättern vergleicht und bei Übereinstimmung vorhandene Wert überträgt.
Zum besseren Verständnis:
Quelldatei: (Quelle.xls)
In der Quelldatei befinden sich in (z.B.) Tabelle5 in der Spalte A die Artikelnummern. In Spalte B befindet sich die Anzahl der verkauften Exemplare. Der Eintrag der Werte erfolgte auf der Basis einer Verknüpfung zu einem anderen Tabellenblatt; die Tabelle 5 ist also eine Hilfstabelle, die die Verknüpfungsergebnisse darstellt.
Es soll beim Anstoßen des Makros (aus der Quelldatei) das Auswahlfenster eingeblendet werden, aus dem die Zieldatei ausgesucht werden muss. Nach dem Aufrufen der Zieldatei sollen die Daten nach Abgleich der Artikelnummern übertragen werden.
Zieldatei:(Ziel.xls; hat nur 1 Sheet)
Es sollen nun die Artikelnummern in der Zieldatei verglichen werden. Die gleichen Artikelnumern befinden sich dort ebenfalls in Spalte A.
Die aus der Quelldatei zu übernehmenden Daten (dort Spalte B) befinden sich hier aber nicht in Spalte B, sondern in Spalte G; und zwar in einem begrenzten Bereich G14 : G80.
Besonderheit:
Nach dem Befüllend er Zieldatei soll diese gespeichert werden; und zwar unter dem Namen, der sich aus der Zelle B9 der Zieldatei ergibt.
Die Originalzieldatei soll wieder geschlossen werden und wieder im ursprünglichen Zustand, also als leeres Formular zur Verfügung stehen; also „schließen ohne speichern“.
Für Hilfe wäre ich sehr dankbar, meine Kenntnisse an ihre Grenzen gestoßen sind; und zwar insbesondere beim Übertrag der Daten.
Hier die Quell- und Zieldatei. Ich habe in den Sheets entsprechende Hinweise germacht.

Die Datei https://www.herber.de/bbs/user/60184.xls wurde aus Datenschutzgründen gelöscht

https://www.herber.de/bbs/user/60185.xls
Danke vorab.
Dietmar Z.
Für Sepp: mir war nicht ganz klar wie ich Dich hier im Forum direkt erreichen kann. Vielleicht liest Du ja diese Nachricht.

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: keine Antwort, da zu wenig know-how, aber...
11.03.2009 21:11:49
Timmy
... du kannst Forenteilnehmer direkt unter Forums-Seiten, Profile, Profilliste erreichen.
Gruss
Timmy
AW: keine Antwort, da zu wenig know-how, aber...
11.03.2009 22:21:31
Dietmar
Hallo Timmy,
vielen Dank für Deinen Tipp!!
Liebe Grüße
Dietmar
AW: Daten in Mappe mit anderem Bereich übertragen
11.03.2009 21:22:20
Josef
Hallo Dietmar,
ich hab dir doch im alten Thread schon geantwortet und eine Datei zum testen bereitgestellt.
https://www.herber.de/forum/messages/1058896.html
Gruß Sepp

AW: Daten in Mappe mit anderem Bereich übertragen
11.03.2009 22:56:06
Dietmar
Hallo Sepp,
ja habe ich auch entdeckt und Dir geantwortet. Hast Du die Antwort erhalten.
Das ist hier für mich noch etwas ungewohnt. Schau auch mal in Deine eMails.
Liebe Grüße
Dietmar
Anzeige
AW: Daten in Mappe mit anderem Bereich übertragen
12.03.2009 22:50:00
Dietmar
Hallo Sepp,
eine (wie ich hoffe) kleine Nuss ist doch noch zu knacken: In der echten Zieldatei erhalten ich folgende Fehlermeldung:
"Fehler 9 Index außerhalb des gültigen Bereichs"
Ich habe nun herausgefunden, dass das an der Bezeichnung des Tabellenblattes der Zieldatei liegt.
Ich hatte Dir ja eine Beispiel-Zieldatei zugeschickt, in der ich das einzige Tabellenblatt mit "Tabelle 1" bezeichnet hatte.
Im Echtbetrieb sieht das aber etwas anders aus:
Auch dort gibt es nur ein einziges Tabellenblatt. Das Etally (die Zieldatei) wird aber jede Woche neu von der Hauptverwaltung zugeschickt. Das Arbeitsblatt selbst hat dann immer einen datumsabhängigen Namen z.B. "Etally010309bis080309"
Dieses Arbeitsblatt hat dann wie gesagt nur 1 Tabellenblatt, das aber auch jede Woche eine neue datumsabhängige Bezeichnung hat. Für den Fall des obigen Arbeitsblattes dann
"German Etally010309bis080309".
In der VBA-Umgebung heißt das Blatt "Sheet2 (German Etally010309bis080309)"
Gibt es dafür eine Lösung?
Ansonsten müsste ich den Code jede Woche anpassen.
Lieben Dank
Gruß Dietmar
Anzeige
AW: Daten in Mappe mit anderem Bereich übertragen
12.03.2009 22:59:42
Josef
Hallo Dietmar,
ändere in Code überall wo Sheets("Tabelle1") steht um in Sheets(1).
Das funktioniert aber nur, wenn wirklich nur ein Blatt in der Mappe ist!
Gruß Sepp

AW: Daten in Mappe mit anderem Bereich übertragen
13.03.2009 21:54:27
Dietmar
Danke Sepp,
das macht hier ja richtig Spass und ich lerne wirklich viel!
Liebe Grüße
Dietmar
AW: Daten übertragen; Gesperrte Zelle ignorieren
16.03.2009 19:28:38
Dietmar
Hallo Sepp,
auf der Grundlage Deines Makros hat sich noch eine Frage ergeben.
Da sich die Zieldatei inhaltlich (nicht jedoch in Bezug auf die grundsätzliche Struktur) regelmäßig ändert, sind ab und zu einzelne Zellen der Zieldatei auch gesperrt sind, so dass dort mit dem aktuellen Makro kein Wert eingetragen werden kann.
Die Quelldatei hat jedoch einen Wert der der Artikelnummer in Spalte A zugewiesen ist. Die die Erhebung der Daten für die Quelldatei geschieht nach anderen Gesichtspunkten als die spätere Auswertung, die mittels der Zieldatei erfolgt. Die Zieldatei kann ich nicht beeinflussen.
Das Passwort ist nicht bekannt. Die Aufhebung des Passwortschutzes wäre auch nicht Sinn der Sache, da die Auswertungsschwerpunkte von Zeit zu Zeit eben verändert werden, so dass die Zieldatei ganz bewusst in einzelnen Zellen der Spalte der Zieldatei gesperrt wird.
Beispiel:
Quelldatei:
CodeNr Bezeichnung Wert
123 Gemüse 24
124 Brot 33
125 Gurken 55
126 Obst 11
127 Wurst 6
Zieldatei:
CodeNr Bezeichnung Wert
123 Gemüse 24
124 Brot gesperrtes Feld, Makro stoppt an dieser Stelle
125 Gurken 55
126 Obst gesperrtes Feld
127 Wurst 6
Beim durchrastern der aus der Quelldatei zu übertragenden Werte trifft das Makro also in der Zieldatei auf eine Zellen, die gesperrt ist. Da in der Quelldatei ein Wert eingetragen ist, versucht das Makro diesen Wert zu übertragen, scheitert aber und gibt die Fehlermelden „schreibgeschützt pp.“. Das Makro stoppt dann, obwohl in der Zelle darunter ein Wert einzutragen wäre.
Kann man das in der angehängten Datei befindliche derart ergänzen, dass es
a) nicht stoppt
b) den Wert, der in die gesperrte Zelle übertragen werden soll, ignoriert
c) mit dem nächsten zu übertragenden Wert fortfährt
Als Anlage habe ich die Quelldatei nochmals beigefügt
Liebe Grüße aus Aachen
Dietmar
https://www.herber.de/bbs/user/60364.xls
Anzeige
AW: Daten übertragen; Gesperrte Zelle ignorieren
16.03.2009 20:57:27
Josef
Hallo Dietmar,
der angepasste Code sollte es tun.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub DatenUebertragen()
  Dim strFile As String, strNewName As String
  Dim objWB As Workbook, objWS As Worksheet, objTarget As Worksheet
  Dim rng As Range, rngF As Range, rngC As Range
  Dim blnOpen As Boolean
  Dim lngRow As Long, lngLast As Long, lngN As Long
  Dim varResult As Variant
  
  On Error GoTo ErrExit
  GMS
  
  strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
    "*.xls; *.xlsx; *.xlsm")
  
  If strFile = "Falsch" Or strFile = ThisWorkbook.FullName Then GoTo ErrExit
  
  blnOpen = IsOpen(strFile)
  
  If blnOpen Then
    Set objWB = Workbooks(Mid(strFile, InStrRev(strFile, "\") + 1))
  Else
    Set objWB = Workbooks.Open(strFile)
  End If
  
  Set objTarget = objWB.Sheets("Tabelle1")
  
  For Each objWS In ThisWorkbook.Worksheets
    With objWS
      Select Case .Name
        Case "PersonalDaten"
          objTarget.Cells(6, 2) = .Cells(2, 2)
          objTarget.Cells(7, 2) = .Cells(3, 2)
          For lngRow = 4 To 7
            objTarget.Cells(lngRow + 6, 2) = .Cells(lngRow, 2)
          Next
        Case "BelegeMarken"
          lngN = 2
          For lngRow = 66 To 71
            objTarget.Cells(lngRow, 3) = .Cells(lngN, 2)
            objTarget.Cells(lngRow, 4) = .Cells(lngN + 3, 2)
            lngN = lngN + 1
            If lngN = 5 Then lngN = 8
          Next
        Case "Gewicht"
          For lngRow = 2 To 6
            objTarget.Cells(lngRow + 189, IIf(lngRow < 5, 3, 2)) = .Cells(lngRow, 2)
          Next
        Case "PV"
          Set rng = .Range("D2:D" & .Cells(Rows.Count, 4).End(xlUp).Row)
          Set rngF = objTarget.Range("A76:A183")
          
          For Each rngC In rng
            If rngC <> "" And IsNumeric(rngC) Then
              varResult = Application.Match(rngC.Offset(0, -3), rngF, 0)
              If IsNumeric(varResult) Then
                objTarget.Cells(varResult + 75, 4) = rngC
              End If
            End If
          Next
        Case "TN"
          Set rng = .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)
          Set rngF = objTarget.Range("A16:A62")
          For Each rngC In rng
            If rngC <> "" And IsNumeric(rngC) Then
              varResult = Application.Match(rngC.Offset(0, -2), rngF, 0)
              If IsNumeric(varResult) Then
                objTarget.Cells(varResult + 15, 7) = rngC
              End If
            End If
          Next
        Case Else
      End Select
    End With
  Next
  
  Application.Calculate
  strNewName = "Etally" & objTarget.Cells(9, 2).Text & Mid(objWB.Name, InStrRev(objWB.Name, "."))
  'strNewName = objTarget.Cells(9, 2).Text & Mid(objWB.Name, InStrRev(objWB.Name, ".")) 'ohne des Namenszusatz Etally
  
  'objWB.SaveAs objWB.Path & "\" & strNewName 'Speichern im gleichen Ordner wie die Original-Zieldatei
  objWB.SaveAs "C:\MLC2008" & "\" & strNewName 'Speichern unter vorgegebenem Pfad
  
  'strSaveAsName = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm)," & _
    ' "*.xls; *.xlsx; *xlsm", InitialFileName:=strNewName, Title:="Überprüfen sie den Dateinamen/Pfad!") 'Speicherpfad abfragen

  objWB.Close
  
  MsgBox "Die Datei " & strNewName & " wurde erfolgreich gespeichert.", vbInformation, "MLC2008 Meeting-Leader-Calculator"
  
  ErrExit:
  
  With Err
    If .Number = 1004 And .Description Like "*schreibgeschützt*" Then
      .Clear
      Resume Next
    End If
    If .Number <> 0 Then MsgBox .Number & vbLf & vbLf & .Description, vbExclamation, "Fehler"
  End With
  GMS True
  Set objWB = Nothing
  Set objWS = Nothing
  Set rng = Nothing
  Set rngF = Nothing
  Set rngC = Nothing
End Sub

Private Sub GMS(Optional ByVal Modus As Boolean = False)
  
  Static lngCalc As Long
  
  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
  End With
  
End Sub

Private Function IsOpen(ByVal WBFullName As String) As Boolean
  Dim objWB As Workbook
  For Each objWB In Application.Workbooks
    If objWB.FullName = WBFullName Then
      IsOpen = True
      Exit For
    End If
  Next
End Function

Gruß Sepp

Anzeige
AW: Daten übertragen; Gesperrte Zelle ignorieren
17.03.2009 22:07:56
Dietmar
Hallo Sepp,
erneut sehr herzlichen Dank!
Das Makro läuft tatsächlich durch!
Habe den Code versucht zu verstehen und habe es geschafft aus der Quelldatei zwei weitere Spalten zu übertragen. Hat geklappt.
Was ist eigentlich an dem Code geändert worden, so dass gesperrte Zellen irgnoriert werden und das Makro nicht stoppt?
Liebe Grüße nach Österreich!
Dietmar
Ein kleines Ergänzungsproblem
26.03.2009 00:18:34
Dietmar
Hallo Sepp,
habe mir erlaubt, Dir erneut auf Deinen eMail-Account zwei Dateien zu schicken. Hier im Forum ging es nicht, da die Dateien etwas zu groß waren.
Soweit hat nun mit Deinem Makro alles geklappt, konnte es auch schon ein wenig auf meine erweiterten Bedürfnisse anpassen.
Nun habe ich aber festgestellt, dass zwei Daten, die in das Etally (was das ist weißt Du ja nun schon :-) ) zwar übertragen werden, aber dort hinsichtlich der Verkettung in die sie eingebunden werden, nicht richtig akzeptiert werden.
Welche beiden Daten es sind habe ich Dir in der Quelldatei im Blatt PersonalDaten erläutert.
Wenn ich die Daten im Etally selbst händisch eingtrage funktioniert es; auch dann, wenn ich die Zellen markiere und dann mit F2 ansteuere und dann wieder verlass.
So gehe ich davon aus, dass irgendwie eine Formatbedingung aus der Quelldatei nicht übermittelt wird. Ich habe schon alle möglichen Formateinstellungen in der Quelldatei ausprobiert - erfolglos.
Weißt Du Rat?
Danke vorab!
Liebe Grüße
Dietmar Zwilling aus Aachen
Anzeige
AW: Ein kleines Ergänzungsproblem - gelöst!!!
26.03.2009 21:58:45
Dietmar
Hallo Sepp,
herzulichen Dank für Deine schnelle Antwort, es funktioniert!
Musste nur noch die Private Function IsOpen .. anhängen.
Ich werde mal Zeile für Zeile durchgehen, vielleicht finde ich ja den Unterschied.
Lieben Dank
Dietmar
AW: Daten übertragen; Gesperrte Zelle ignorieren
17.04.2009 20:32:20
Dietmar
Hallo Sepp,
habe mir erneut erlaubt, Dir eine eMail zu übersenden und drei Anhängen drangehängt.
Die Firma hat die Zieldatei einfach in der Struktur verändert, so dass der Code leider nicht mehr nutzbar ist.
Ich möchte aber ungerne den Code immer verändern nur weil die Leutchen, die sich keine Gedanken darüber zu machen scheinen, einfach neue Zeilen dazwischenschieben.
Habe versucht es dir so verständlich wie möglich darzustellen.
Ich hoffe, es gibt eine Möglichkeit, auf sich verschiebende Bereiche in der Zeildatei angemessen per Code zu reagieren.
Anderenfalls scheint mein Projekt zu scheitern.
Den Versuche einer Idee habe ich in meiner Mail geschildert.
Das Problem ist halt, dass derartige Verschiebungen in der Zeilenebene auch zukünftig nicht auszuschließen sein werden. Die Spaltezuweisung ist fest geblieben.
Würdest Du Dich des Problems nochmals annehmen ?
Herzlichen Dank vorab !!!
Liebe Grüße
Dietmar aus Aachen
Anzeige
AW: Daten in Mappe mit anderem Bereich übertragen
13.03.2009 20:56:22
Dietmar
Hallo Sepp,
Entwarnung! Hatte nicht nachgedacht. Soviel hätte ich doch eigentlich sofort wissen sollen! Problem lässt sich natürlich umgehen, wenn ich statt ("Tabelle1") nur (1) eingebe.
An einer anderen Sache wäre ich aber noch interessiert:
Ich würde gerne eine Art Tagesergebnisblatt erzeugen. D.h. alle mit Stückzahlen gefüllten Zeilen und die in der Zieldatei erzeugten Kopfzeilen sollten dann in eine eigenständige Datei (leeres Arbeitsblatt) übertrragen werden. Alle Zeilen in denen keine Vekaufswerte stehen sollen dann unberücksichtigt bleiben.
Liebe Grüße
Dietmar
AW: Daten in Mappe mit anderem Bereich übertragen
13.03.2009 21:35:23
Josef
Hallo Dietmar,
erstelle so ein Blatt und lade es hoch, damit ich sehe wohin die Werte geschrieben werden sollen.
Soll diese neue Datei gleich abgespeichert werden? Wenn ja, wohin und unter welchem Namen?
Gruß Sepp

Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige