Hallo,

deine Angaben reichen so nicht um eine Lösung anzubieten. Ich vermute, das im Namensverzeichnis und Toc irgendwo gleiche Angaben stehen, dann könnte man vielleicht mit Sverweis() arbeiten.

Du solltest deine Angaben etwas genauer machen oder eine Beispieldatei zur Verfügung stellen

Gruß

Helmut

http://cid-81e27d727b7e7d46.skydrive.live.com/self.aspx/ datenbank/Datenbank%7C_UnderConstruction.xls

hoffe die link funktioniert...da ist die rohtabelle.

also trägt man auf dem sheet Kontakte(übersicht) etwas in die blauen spalten (bspw. 89MM) soll das was dort drin steht auch auf dem jeweiligen Sheet übernommen werden. Text von Kontakt soll zu Bemerkung im eigenen Sheet (in dem Falle 89MM)
zusätzlich wenn das passiert soll (wenn möglich) auch LAND; NAME/PERSON und SENDER ü^*xxxxxxxxx*bernommen werden.

also
WENN "TEXT" in Kästchen 89MM (Sheet: Kontakt)
DANN Inhalt übertragen in Bemerkungen (SHEET 89MM)
UND name (S: Kontakt) zu Person(S:89MM), land zu land und sender zu sender..

ist das überhaupt möglich??

^{*Threadedit* 23.10.2008, 14:39:36
Admininfo: Achte bei Links bitte auf unseren Frame. Nutze die Hilfe oder das SNTool}

Hallo,

dein Link führt ins Gebüsch

Gruß

Helmut

http://cid-81e27d727b7e7d46.skydrive.live.com/browse.aspx/datenbank

Hallo,

habe mir die Sache mal angesehen, aus meiner Sicht nur per Makro zu lösen und da etwas Aufwand.

Gruß

Helmut

danke schonmal..hab geahnt dass es in diesem umfang mit einfachen mitteln kaum zu lösen ist. schade trotzdem.

ist nicht zwingend an GENAU diese Lösung gebunden. gibt es vielleicht alternativen? so aus erfahrungen heraus..

Hallo miteinander,
als Alternative habe ich hier dieses Makro:

Sub Makro1()
Dim vonBlatt As String
Dim vonZeile As Integer
vonBlatt = "KONTAKTE(ÜBERSICHT)"
vonZeile1 = 4
Dim nachBlatt As String
Dim nachZeile As Integer
nachBlatt = "89 MM"
nachZeile = 5
'
For i = 0 To Sheets(vonBlatt).Range("M" & Rows.Count).End(xlUp).Row - vonZeile1
    If Not IsEmpty(Sheets(vonBlatt).Range("M" & i + vonZeile1)) Then
        Sheets(nachBlatt).Range("G" & nachZeile) = Sheets(vonBlatt).Range("M" & i + vonZeile1)
        Sheets(nachBlatt).Range("C" & nachZeile) = Sheets(vonBlatt).Range("F" & i + vonZeile1)
        Sheets(nachBlatt).Range("A" & nachZeile) = Sheets(vonBlatt).Range("B" & i + vonZeile1)
        Sheets(nachBlatt).Range("B" & nachZeile) = Sheets(vonBlatt).Range("C" & i + vonZeile1)
        nachZeile = nachZeile + 1
    End If
Next i

End Sub

Es schreibt in "89 MM" aufeinanderfolgend die Daten aus der Übersicht.

Gruß
lorf

PS: Das nächste Mal das Testbeispiel besser anonymisieren. Du magst sicher auch keinen Spam, um es mal nett zu sagen. Also lass es am Besten sofort von deinem Live-Account verschwinden.

hallo lorf,

vielen dank; klappt soweit super :)
hab allerdings das erste mal mit makros zu tun und irgendwie muss ich die jedes neu ausführen..alle 12 um die sachen zu übertragen..gibts da eine automatische variante? etwas das die makros automatisch ausführt?

grüße

wer, wann, was, wo, wie?
Wann sollen welche Makros wie und wo automatisch ausgeführt werden?

sorry..

also in diesem falle soll sub makro1() beim öffnen automatisch gestartet werden..so dass die datenbank beim öffnen immer aktuell ist.

habs über "diese arbeitsmappe" worbook / open versucht


Private Sub Workbook_Open()

Dim vonBlatt As String
Dim vonZeile As Integer
vonBlatt = "KONTAKTE(ÜBERSICHT)"
vonZeile1 = 4
Dim nachBlatt As String
Dim nachZeile As Integer
nachBlatt = "89 MM"
nachZeile = 5
'
For i = 0 To Sheets(vonBlatt).Range("M" & Rows.Count).End(xlUp).Row - vonZeile1
If Not IsEmpty(Sheets(vonBlatt).Range("M" & i + vonZeile1)) Then
Sheets(nachBlatt).Range("G" & nachZeile) = Sheets(vonBlatt).Range("M" & i + vonZeile1)
Sheets(nachBlatt).Range("C" & nachZeile) = Sheets(vonBlatt).Range("F" & i + vonZeile1)
Sheets(nachBlatt).Range("A" & nachZeile) = Sheets(vonBlatt).Range("B" & i + vonZeile1)
Sheets(nachBlatt).Range("B" & nachZeile) = Sheets(vonBlatt).Range("C" & i + vonZeile1)
nachZeile = nachZeile + 1
End If
Next i

End Sub

das funktioniert auch..allerdings gibts ja nicht nur den film 89MM sondern 11 weitere..folgt:

Dim vonBlatt As String
Dim vonZeile As Integer
vonBlatt = "KONTAKTE(ÜBERSICHT)"
vonZeile1 = 4
Dim nachBlatt As String
Dim nachZeile As Integer
nachBlatt = "Beijing Bubbles"
nachZeile = 5
'
For i = 0 To Sheets(vonBlatt).Range("N" & Rows.Count).End(xlUp).Row - vonZeile1
If Not IsEmpty(Sheets(vonBlatt).Range("N" & i + vonZeile1)) Then
Sheets(nachBlatt).Range("G" & nachZeile) = Sheets(vonBlatt).Range("N" & i + vonZeile1)
Sheets(nachBlatt).Range("C" & nachZeile) = Sheets(vonBlatt).Range("F" & i + vonZeile1)
Sheets(nachBlatt).Range("A" & nachZeile) = Sheets(vonBlatt).Range("B" & i + vonZeile1)
Sheets(nachBlatt).Range("B" & nachZeile) = Sheets(vonBlatt).Range("C" & i + vonZeile1)
nachZeile = nachZeile + 1
End If
Next i


nur funktioniert das nur bei 89MM..füge ich dieses ein, wird mir eine fehlermeldung angezeigt.

also be der automatisierung...einzeln als makros hätte es geklappt, wäre aber sehr zeitaufwändig die jedes mal einzeln aufzurufen..

Ok, jetzt habe ich das verstanden.

Das folgende Makro bitte in "DieseArbeitsmappe" kopieren, damit Workbook_Open funktioniert.
Wenn weitere Filme dazu kommen, kann man in FilmspalteBis das Y gegen die entsprechende Spalte austauschen.

Das Makro holt sich den Namen des Arbeitsblattes, das die Werte erhalten soll, aus der 3. Zeile (M3 bis Y3). Wenn der Name falsch geschrieben ist bzw. es kein Arbeitsblatt mit dem Namen gibt, kommt eine Fehlermeldung. Die kommt sicher öfter, weil einige Filmtitel in der 3. Zeile nicht der Schreibweise bei den Arbeitsblattnamen entsprechen. Aber irgendwie muss man ja eine Zuordnung finden.
Das DatenKopieren habe ich als Extra-Sub stehen gelassen, damit man sich das noch auf ein Icon oder menüeintrag legen kann.

Private Sub Workbook_Open()
  DatenKopieren
End Sub

Sub DatenKopieren()

Dim i As Integer, film As Integer
Dim FilmspalteVon As Integer
Dim FilmspalteBis As Integer
FilmspalteVon = Asc("M") - Asc("A") + 1
FilmspalteBis = Asc("Y") - Asc("A") + 1

Const vonBlatt As String = "KONTAKTE(ÜBERSICHT)"
Const vonZeile As Integer = 4

Dim nachBlatt As String
Dim nachZeile As Integer
'
For film = FilmspalteVon To FilmspalteBis
    nachZeile = 5
    nachBlatt = Sheets(vonBlatt).Cells(vonZeile - 1, film) 'vonBlatt: Tabellennnamen in Zeile3 Spalte M bis Y
    If DoesSheetExist(nachBlatt) Then
        For i = 0 To Sheets(vonBlatt).Cells(Rows.Count, film).End(xlUp).Row - vonZeile
            If Not IsEmpty(Sheets(vonBlatt).Cells(i + vonZeile, film)) Then
                Sheets(nachBlatt).Range("G" & nachZeile) = Sheets(vonBlatt).Cells(i + vonZeile, film)
                Sheets(nachBlatt).Range("C" & nachZeile) = Sheets(vonBlatt).Range("F" & i + vonZeile)
                Sheets(nachBlatt).Range("A" & nachZeile) = Sheets(vonBlatt).Range("B" & i + vonZeile)
                Sheets(nachBlatt).Range("B" & nachZeile) = Sheets(vonBlatt).Range("C" & i + vonZeile)
                nachZeile = nachZeile + 1
            End If
        Next i
    End If
Next film
End Sub

Function DoesSheetExist(SheetName As String) As Boolean
Dim wS As Worksheet
DoesSheetExist = True
    On Error Resume Next
    Set wS = Sheets(SheetName)
    If wS Is Nothing Then 'Name falsch oder Arbeitsblatt existiert nicht
        DoesSheetExist = False
        MsgBox "Arbeitsblatt " & SheetName & " nicht gefunden.", vbCritical, "Fehler"
        Set wS = Nothing
    End If

End Function

Gruß
lorf

guten morgen lorf,

klappt super..kurzes ausbessern der sheetnamen und es läuft reibungslos. vielen dank. hat mich echt ein riesen stück voran gebracht..

Denn können wir ja einen Haken dran machen und uns freuen.