Office: (Office 2013) VBA Code-automatisches Kopieren von Excel-Inhalten; unterschiedliche Speicherorte

Helfe beim Thema VBA Code-automatisches Kopieren von Excel-Inhalten; unterschiedliche Speicherorte in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Liebes Forum, ich melde mich mal wieder mit einer Frage zu einem VBA Code. Meine Excel-Masterdatei liegt auf einem Sharepoint im Ordner "A" und... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Nelspruit, 22. November 2017.

  1. Nelspruit hat Ahnung

    VBA Code-automatisches Kopieren von Excel-Inhalten; unterschiedliche Speicherorte


    Liebes Forum,

    ich melde mich mal wieder mit einer Frage zu einem VBA Code.

    Meine Excel-Masterdatei liegt auf einem Sharepoint im Ordner "A" und soll automatisch mit einem einzigen Button Klick mit bestimmten Inhalten von 13 Quelldateien (Quelldatei 1, ..., Quelldatei 13) befüllt werden. Die Quelldateien liegen auf selbigem Sharepoint aber in den Ordnern "B", "C", (...), "N".
    Der Sharepoint ist mit einem meiner Netzlaufwerke verbunden.

    Im Anhang sind Beispielsdateien. Master- und Quelldatei sind identisch formatiert und aufgebaut. Nur werden die Inhalte in der Quelldatei von unterschiedlichen Personen bearbeit und permanent geändert. Die Masterdatei soll per Klick bestimmte Inhalte der Quelldateien ziehen, so dass mit diesen in der Masterdatei weitergearbeitet werden kann (ohnen lästiges manuelles kopieren). Kopiert werden sollen nur Inhalte (keine Formeln) und die Formatierung der Masterdatei darf nicht überschrieben werden.

    Kopiert werden sollen von der

    1. Quelldatei1 Sheet 1a die beschriebenen Inhalte der Zellen E10:M(last row), AF10:AF(last row) und AP10:AP(last row)
    2. Quelldatei1 Sheet 1b die beschriebenen Inhalte der Zellen E12:K(last row), M12:V(last row) und N3:Q8
    3. Quelldatei2 Sheet 2a die beschriebenen Inhalte der Zellen E10:M(last row), AF10:AF(last row) und AP10:AP(last row)
    4. Quelldatei2 Sheet 2b die beschriebenen Inhalte der Zellen E12:K(last row), M12:V(last row) und N3:Q8


    Eingefügt werden sollen in die Masterdatei
    1. Oben genannte Inhalte der Queldatei1 des Sheets 1a und 1b in die Sheets Master 1a bzw. 1b in exakt die gleichen Zellen wie auch von der Quelldatei beschrieben.
    2. Oben genannte Inhalte der Queldatei2 des Sheets 2a und 2b in die Sheets Master 2a bzw. 2b in exakt die gleichen Zellen wie auch von der Quelldatei beschrieben.


    Kann mir hier jemand helfen?

    Vielen Dank und beste Grüße
    Nelspruit
     
    Nelspruit, 22. November 2017
    #1
  2. Nelspruit hat Ahnung
    Liebes Forum,

    unten stehenden Code habe ich mir zusammengebastelt, um mich meinem Problem zu nähern. Der Code funktioniert auch soweit gut.
    Mit meinem dürftigen Kenntnissstand muss ich den Code nun in jedes meiner 13 Mastersheets einfügen und ihn je Arbeitsbladd über ein Commandbutton aktivieren. Das ist eigentlich nicht die Lösung die ich wollte (nur ein Commandbutton war ursprünglich gewünscht statt 13), aber besser bekomme ich es nicht hin. Im Nachhinein ist diese Lösung aber vielleicht gar nicht so verkehrt.

    Private Sub CommandButton1_Click()

    Workbooks.Open "P:\VBA\Quelldatei1.xlsx"
    With Worksheets("Quelldatei1a").Range("E10:M200")
    .Copy _
    Destination:=Workbooks("Master").Sheets("Master1a").Range("E10")
    With Worksheets("Quelldatei1a").Range("AF10:AF200")
    .Copy _
    Destination:=Workbooks("Master").Sheets("Master1a").Range("AF10")
    With Worksheets("Quelldatei1a").Range("AP10:AP200")
    .Copy _
    Destination:=Workbooks("Master").Sheets("Master1a").Range("AP10")

    With Worksheets("Quelldatei1b").Range("E12:K100")
    .Copy _
    Destination:=Workbooks("Master").Sheets("Master1b").Range("E12")
    With Worksheets("Quelldatei1b").Range("M12:V100")
    .Copy _
    Destination:=Workbooks("Master").Sheets("Master1b").Range("M12")
    With Worksheets("Quelldatei1b").Range("N2:Q8")
    .Copy _
    Destination:=Workbooks("Master").Sheets("Master1b").Range("N2")
    End With
    End With
    End With
    End With
    End With
    End With
    Workbooks("Quelldatei1.xlsx").Close SaveChanges:=True
    End Sub

    Vielleicht kann mir noch jemand aus dem Forum helfen, den Code effizienter/besser zu machen, so dass zum Beispiel bis zur letzten Zeile gezählt wird (die Spalten sind immer fix)? Die Beispielsdateien mit dem Code sind im Anhang

    Viele Grüße und danke
    Nelspruit
     
    Nelspruit, 23. November 2017
    #2
  3. Exl121150 Erfahrener User
    Hallo,

    ich habe in der beigefügten Datei deine Excel-Datei "Master.xlsm" modifiziert, indem ich
    • ein weiteres Arbeitsblatt "Verzeichnis" eingefügt habe, das die Tabelle "TabVerzeichnis" und den Button "cmdMappen_Einlesen_Click" enthält, ferner etwas Kommentar.
    • dein Makro geändert habe und in das Codemodul des neuen Arbeitsblattes verschoben habe.
    • weiters das Klassenmodul "clsTabRow" eingefügt habe. Dieses dient zum bequemen Lesen der Daten der Tabelle "TabVerzeichnis", was du in der Sub "cmdMappen_Einlesen_Click()" sehen kannst (Objektinstanz "tabVerz"). In dieser Sub findest du auch alle Tabellenbezeichnungen (Spaltennamen, etc.), falls du sprachliche Änderungen an der Tabelle "TabVerzeichnis" vornehmen möchtest.
    • An die Sub "TabVerzeichnis_SatzLesen(...)" werden die Werte 1 Zeile aus Tabelle "TabVerzeichnis" übergeben und dort die von dir gewünschten Kopiervorgänge für 1 Quell-Exceldatei ausgeführt.
    • Alle mit "Ja" gekennzeichneten Zeilen werden automatisch nacheinander ausgeführt.
     
    Zuletzt bearbeitet: 24. November 2017
    Exl121150, 24. November 2017
    #3
  4. Nelspruit hat Ahnung

    VBA Code-automatisches Kopieren von Excel-Inhalten; unterschiedliche Speicherorte

    Lieber Anton,

    das ist ja super, vielen Dank :-) Die Funktion des selektiven Einlesens/Importierens finde ich klasse. Hast du den Code einfach aus dem Ärmel gezaubert... bin perplex.

    Besten Dank, ich bin noch dabei, den Code zu übernehmen und die Namen zu ändern...! Habe leider deinen Beitrag erst gerade gelesen:-)

    Viele Grüße
    Nelspruit
     
    Zuletzt von einem Moderator bearbeitet: 30. November 2020
    Nelspruit, 27. November 2017
    #4
  5. Nelspruit hat Ahnung
    -

    Hallo Anton,

    sorry, dass ich nochmal deine Hilfe erbitten muss!

    ich habe den Code von dir übernommen und sprachliche Änderungen vorgenommen (Feldwertnamen, Worksheet Name "Navigation" statt "Verzeichnis"; Update statt TabVerzeichnis). Über den Namensmanager habe ich den Namen "Update" für die Tabelle definiert (statt "TabVerzeichnis"). Nun bekomme ich den Fehler "Compile Error: Variable not found" (s. JPeg im Anhang) für das Klassenmodul. Weiter unten mein Code für den Commandbutton bzw. das Tab Verzeichnis (umbenannt zu "Navigation").

    Deinen Code für das Klassenmodul habe ich ebenfalls übernommen und lediglich eine Änderung vorgenommen ( "Verzeichnis" umbenannt zu "Navigation" - siehe rote Markeirung). Der Code ist ebenfalls weiter unten gelistet.

    Könntest du mir nochmal helfen? Leider kann ich die Originaldatei nicht anhängen...

    Danke und liebe Grüße
    Nelspruit



    Option Explicit

    Private Sub Update_Click()

    Dim tabVerz As New clsTabRow

    On Error GoTo Err_cmdMappen_Ein

    With tabVerz
    .Tabelle = .GetTabelle(TabBez:="Update", Blatt:="Navigation")
    .FirstFilteredTabSatz FilterWert:="Yes", Fld:="Update?"

    Do Until .TabEnde
    Update_SatzLesen Source_path:=.FeldWert("Source_path"), _
    Source1:=.FeldWert("Source1"), Source2:=.FeldWert("Source2"), _
    Master1:=.FeldWert("Master1"), Master2:=.FeldWert("Master2")
    .NxtFilteredTabSatz FilterWert:="Yes", Fld:="Update?"
    Loop
    End With 'tabVerz

    Err_cmdMappen_Ein:
    Set tabVerz = Nothing
    End Sub

    Private Sub Update_SatzLesen(Source_path$, Source1$, Source2$, Master1$, Master2$)
    Dim ZlQ As Long
    Dim WbM As Workbook, WsM As Worksheet

    On Error GoTo Err_TabVerz_Lesen

    Set WbM = ActiveWorkbook
    With Workbooks.Open(Filename:=Source_path$)
    With .Worksheets(Source1$)
    Set WsM = WbM.Worksheets(Master1$)
    ' 1. Quelldatei1 Sheet 1a die beschriebenen Inhalte der Zellen E10:M(last row), AF10:AF(last row) und AP10:AP(last row)
    With .UsedRange: ZlQ = .Row + .Rows.Count - 1: End With
    .Range(.Range("D10"), .Cells(ZlQ, "M")).Copy Destination:=WsM.Range("D10")
    .Range(.Range("AF10"), .Cells(ZlQ, "AF")).Copy Destination:=WsM.Range("AF10")
    .Range(.Range("AP10"), .Cells(ZlQ, "AP")).Copy Destination:=WsM.Range("AP10")
    .Range("I3:I6").Copy Destination:=WsM.Range("I3")
    .Range("BE1:BF6").Copy Destination:=WsM.Range("BE1")
    End With
    With .Worksheets(Source2$)
    Set WsM = WbM.Worksheets(Master2$)
    ' 2. Quelldatei1 Sheet 1b die beschriebenen Inhalte der Zellen E12:K(last row), M12:V(last row) und N3:Q8
    With .UsedRange: ZlQ = .Row + .Rows.Count - 1: End With
    .Range(.Range("E12"), .Cells(ZlQ, "K")).Copy Destination:=WsM.Range("E12")
    .Range(.Range("M12"), .Cells(ZlQ, "V")).Copy Destination:=WsM.Range("M12")
    .Range("N3:Q8").Copy Destination:=WsM.Range("N3")
    End With
    .Close SaveChanges:=False
    End With 'Quellmappe
    Exit Sub
    Err_TabVerz_Lesen:
    MsgBox Prompt:="Fehler beim Einlesen der Excel-Mappe" & vbNewLine & Quellmappe$ & vbNewLine & vbNewLine & _
    "FehlerNr=" & Err.Number & " (" & Err.Description & ")", Buttons:=vbCritical, Title:="Fehler"
    End Sub


    Code:
    Option Explicit
    
    'Objektklasse dient zum Verwalten von Excel-Tabellen (ListObjects),
    '                                 von deren Sätzen   (ListRows)
    '                                 und deren Feldern  (ListColumns).
    
    Private m_rowSatz As ListRow        'Aktueller Satz der Tabelle
    Private m_rowSatz1 As ListRow       'Gemerkter Satz der Tabelle
    Private m_lstTabelle As ListObject   'Tabelle
    '
    
    '
    '*************************************************************************
    '************* Klassen-Methoden ******************************************
    '*************************************************************************
    
    'Klassenkonstruktor
    Private Sub Class_Initialize()
    '
    End Sub
    'Klassendestruktor
    Private Sub Class_Terminate()
      Set m_rowSatz = Nothing
      Set m_lstTabSourceelle = Nothing
    End Sub
    
    
    '*************************************************************************
    '************* Tabellen-Eigenschaften, -methoden *************************
    '*************************************************************************
    
    'Eigenschaft: Tabelle (lesen/schreiben)
    'Lesen: gibt das aktuelle Tabellenobjekt zurück
    Property Get Tabelle() As ListObject
      Set Tabelle = m_lstTabelle
    End Property
    'Schreiben: speichert das zugewiesene Tabellenobjekt "aLst".
    '           Falls dieses Sätze besitzt, wird der erste Satz als aktueller Tabellensatz gespeichert.
    Property Let Tabelle(aLst As ListObject)
      Set m_lstTabelle = aLst
      If aLst.ListRows.Count > 0 Then
        Set m_rowSatz = aLst.ListRows(1)
      Else
        Set m_rowSatz = Nothing
      End If
    End Property
    '
    'Methode ermittelt mittels "Blatt$" und "TabBez" das dazugehörige Tabellenobjekt und gibt es zurück
    '
    [COLOR="#FF0000"]Function GetTabelle(ByVal TabBez As Variant, Optional Blatt$ = "Navigation") As ListObject[/COLOR]
      Select Case VarType(TabBez)
        Case vbInteger, vbLong, vbByte, vbString
          Set GetTabelle = Worksheets(Blatt$).ListObjects(TabBez)
        Case vbObject
          Set GetTabelle = TabBez
        Case Else
          Set GetTabelle = Nothing
      End Select
    End Function
    '
    'Methoden ermitteln die Bereiche des Tabellenobjektes
    '
    Function Kopfbereich() As Range
      Set Kopfbereich = m_lstTabelle.HeaderRowRange
    End Function
    Function Datenbereich() As Range
      Set Datenbereich = m_lstTabelle.DataBodyRange
    End Function
    Function Totalbereich() As Range
      Set Totalbereich = m_lstTabelle.TotalsRowRange
    End Function
    '
    'Spezielle Tabellenmethoden:
    '
    Function AlleSätze() As ListRows
      Set AlleSätze = m_lstTabelle.ListRows
    End Function
    Function AlleFelder() As ListColumns
      Set AlleFelder = m_lstTabelle.ListColumns
    End Function
    Function SatzAnz() As Long
      SatzAnz = Me.AlleSätze.Count
    End Function
    Function FeldAnz() As Long
      FeldAnz = Me.AlleFelder.Count
    End Function
    '
    'Sortiere die Tabelle auf/absteigend
    '  nach folgenden Feld(numm)ern: SortSp(1)..SortSp(n)
    '  Jedes SortSp(i) hat folgende Syntax:  "SpName|{A|D}" oder nur "SpName" (="SpName|A")
    '  wobei A=Aufsteigend, D=Absteigend
    '
    Sub TabSätzeSort(ParamArray SortSp() As Variant)
      Dim Tok$(), RgFld As Range, SortSpEl As Variant
      Dim AufAb As XlSortOrder
        
      With m_lstTabelle.Sort
        With .SortFields
          .Clear
          For Each SortSpEl In SortSp
            Tok$ = Split(SortSpEl, "|")
            AufAb = xlAscending: If UBound(Tok$) = 1 Then If Tok$(1) = "D" Then AufAb = xlDescending
            Set RgFld = m_lstTabelle.ListColumns(Tok$(0)).Range
            .Add Key:=RgFld, SortOn:=xlSortOnValues, Order:=AufAb, DataOption:=xlSortTextAsNumbers
          Next SortSpEl
        End With
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
      End With
    End Sub
    
    
    '*************************************************************************
    '************* Satz-Eigenschaften, -methoden *****************************
    '*************************************************************************
    
    
    Function GetSatz_Zelle(Zelle As Range) As ListRow
      On Error GoTo Err_GetSatz4Zelle
      With Zelle.ListObject
        Set GetSatz_Zelle = .ListRows(Zelle.Row - .HeaderRowRange.Row)
      End With
      Exit Function
    Err_GetSatz4Zelle:
      Set GetSatz_Zelle = Nothing
    End Function
    
    Function GetSatz_ZelleInTab(Zelle As Range) As ListRow
      On Error GoTo Err_GetTabSatz4Zelle
      With Zelle.ListObject
        If .Name <> m_lstTabelle.Name Then Err.Raise 421 'Methode auf dieses Objekt nicht anwendbar!
        Set GetSatz_ZelleInTab = .ListRows(Zelle.Row - .HeaderRowRange.Row)
      End With
      Exit Function
    Err_GetTabSatz4Zelle:
      Set GetSatz_ZelleInTab = Nothing
    End Function
    
    
    Property Get TabSatzNr() As Long
      On Error GoTo Err_TabSatzNrL
      TabSatzNr = m_rowSatz.Index
      Exit Property
    Err_TabSatzNrL:
      TabSatzNr = 0
    End Property
    
    Property Let TabSatzNr(Nr As Long)
      On Error GoTo Err_TabSatzNrS
      Set m_rowSatz = m_lstTabelle.ListRows(Nr)
      Exit Property
    Err_TabSatzNrS:
      Set m_rowSatz = Nothing
      MsgBox Prompt:="Diese (aktuelle) Satznr. ist unerlaubt. ", Buttons:=vbCritical, Title:="Ungültige Satznr."
    End Property
    
    
    
    
    Property Get TabSatz() As ListRow
      Set TabSatz = m_rowSatz
    End Property
    
    Property Set TabSatz(aRw As ListRow)
      Dim Lst As ListObject
      On Error GoTo Err_SetTabSatz
      If Not aRw Is Nothing Then
        Set Lst = aRw.Parent
        If Lst.Name <> m_lstTabelle.Name Then Err.Raise 421
      End If
      Set m_rowSatz = aRw
      Exit Property
    Err_SetTabSatz:
      MsgBox Prompt:="Satzobjekt gehört zu einer anderen Tabelle!" & vbNewLine & "Tab=" & m_lstTabelle.Name & ", Row=" & Lst.Name, _
             Buttons:=vbCritical, Title:="Tabelle/Satz ?"
    End Property
    
    
    
    Function TabReadSatz(ParamArray Werte() As Variant) As Boolean
      Dim Wi&, WLzt&, I&, Ende As Boolean
      
      Wi& = LBound(Werte()): WLzt& = UBound(Werte())
      For I& = 1 To Me.FeldAnz
        If Wi& > WLzt& Then Exit For 'Vergiss die eventuell restlichen Felder des Satzes
        Werte(Wi&) = Me.FeldWert(I&): Wi& = Wi& + 1
      Next I&
      TabReadSatz = Not Me.NxtTabSatz() '=TRUE, falls Tabellenende überschritten; =FALSE, falls sonst.
    End Function
    
    
    Property Get Satz() As ListRow
      Set Satz = TabSatz()
    End Property
    
    Property Set Satz(aRw As ListRow)
      Set m_rowSatz = aRw
      If Not aRw Is Nothing Then
        Set m_lstTabelle = aRw.Parent
      End If
    End Property
    
    
    
    Property Get Satz1() As ListRow
      Set Satz1 = m_rowSatz1
    End Property
    Property Set Satz1(aRw As ListRow)
      Set m_rowSatz1 = aRw
    End Property
    
    Function TabEnde() As Boolean
      TabEnde = m_rowSatz Is Nothing
    End Function
    
    Function FirstFilteredTabSatz(ByVal FilterWert As Variant, Optional Fld As Variant = 1) As Boolean
      TabSatzNr = 1
      If FeldWert(Fld) <> FilterWert Then
        Do While NxtTabSatz()
          If FeldWert(Fld) = FilterWert Then Exit Do
        Loop
      End If
      FirstFilteredTabSatz = Not Me.TabEnde
    End Function
    
    Function NxtFilteredTabSatz(ByVal FilterWert As Variant, Optional Fld As Variant = 1) As Boolean
      Do While NxtTabSatz()
        If FeldWert(Fld) = FilterWert Then Exit Do
      Loop
      NxtFilteredTabSatz = Not Me.TabEnde
    End Function
    
    Function NxtTabSatz(Optional NxtNr& = 1, Optional ByRef TabSatz As ListRow) As Boolean
      Dim NxtIdx&
      NxtIdx& = m_rowSatz.Index + NxtNr&
      With m_lstTabelle
        If NxtIdx& < 1 Then
          Set m_rowSatz = Nothing
        ElseIf NxtIdx& > .ListRows.Count Then
          Set m_rowSatz = Nothing
        Else
          Set m_rowSatz = .ListRows(NxtIdx)
        End If
      End With
      Set TabSatz = m_rowSatz
      NxtTabSatz = Not m_rowSatz Is Nothing
    End Function
    
    Public Function KeyTabSatz(Key$, Optional KeySp As Variant) As ListRow
      Dim rowZeile As ListRow
      Dim KeySpNr&
      
      If IsMissing(KeySp) Then KeySp = "Key"
      KeySpNr& = m_lstTabelle.ListColumns(KeySp).Index
      For Each rowZeile In m_lstTabelle.ListRows
        If rowZeile.Range.Cells(KeySpNr&) = Key$ Then
          Set KeyTabSatz = rowZeile
          Exit Function
        End If
      Next rowZeile
      Set KeyTabSatz = Nothing
      
    End Function
    
    Public Function KeyTabMatch(KeyWert As Variant, Optional KeySp As Variant, Optional Sort% = 1) As ListRow
      Dim rngKeySp As Range
      On Error GoTo Err_MATCH
      If IsMissing(KeySp) Then KeySp = "Key"
      With m_lstTabelle
        Set rngKeySp = .ListColumns(KeySp).DataBodyRange
        Set KeyTabMatch = .ListRows(WorksheetFunction.Match(KeyWert, rngKeySp, Sort%))
      End With
      Exit Function
    Err_MATCH:
      Set KeyTabMatch = Nothing
    End Function
    
    Function TabSatzAnfügenLeer() As ListRow
      Set m_rowSatz = m_lstTabelle.ListRows.Add
      Set TabSatzAnfügenLeer = m_rowSatz
    End Function
    
    Function TabSatzEinfügenLeer(Nr As Long) As ListRow
      On Error GoTo Err_TabSatzEinfügen
      Set m_rowSatz = m_lstTabelle.ListRows.Add(Position:=Nr)
      Set TabSatzEinfügenLeer = m_rowSatz
      Exit Function
    Err_TabSatzEinfügen:
      Set TabSatzEinfügenLeer = Nothing
    End Function
    
    
    
    '*************************************************************************
    '************* Feld-Eigenschaften, -methoden *****************************
    '*************************************************************************
    '
    'Methode "FeldNr": gibt die Spaltennummer des Feldes innerhalb der Tabelle zurück.
    '        Wenn das Feld in der Tabelle nicht existiert, wird 0 zurückgegeben.
    Function FeldNr(Fld As Variant) As Long
      On Error GoTo Err_FeldNr
      FeldNr = m_lstTabelle.ListColumns(Fld).Index
      Exit Function
    Err_FeldNr:
      FeldNr = 0
    End Function
    'Methode "FeldNameNr": gibt den Feldnamen des Feldes mit der Nr. "Fld" innerhalb der Tabelle zurück.
    '        Wenn die FeldNr. in der Tabelle nicht existiert, wird "" zurückgegeben.
    Function FeldNameNr(Fld As Variant) As String
      On Error GoTo Err_FeldNameNr
      FeldNameNr = m_lstTabelle.ListColumns(Fld).Name
      Exit Function
    Err_FeldNameNr:
      FeldNameNr = ""
    End Function
    'Methode "Feld": gibt für den aktuellen Datensatz den Zellbereich des Feldes zurück,
    '        das über "Fld" (Spaltennummer bzw. Spaltenname) angesprochen wurde
    Function Feld(Fld As Variant) As Range
      Dim ColIdx As Long
      ColIdx = m_lstTabelle.ListColumns(Fld).Index
      Set Feld = m_rowSatz.Range.Cells(ColIdx)
    End Function
    'Methode "FeldName": gibt den aktuellen Feldnamen der Tabelle zurück, in dem "Zelle" liegt.
    '        Falls "Zelle" in keiner Tabelle liegt, wird "" zurückgegeben.
    Function FeldName(Zelle As Range) As String
      On Error GoTo Err_FeldName
      With Zelle.ListObject
        FeldName = .ListColumns(Zelle.Column - .HeaderRowRange.Column + 1).Name
      End With
      Exit Function
    Err_FeldName:
      FeldName = ""
    End Function
    'Methode "FeldSpalte": gibt den gesamten Arbeitsblatt-Spaltenbereich zurück,
    '        in dem sich das Feld "Feld" befindet.
    Function FeldSpalte(Fld As Variant) As Range
      Set FeldSpalte = Feld(Fld).EntireColumn
    End Function
    'Methode "TabFeld": gibt das Tabellenspaltenobjekt zurück,
    '        das über "Fld" (Spaltennummer bzw. Spaltenname) angesprochen wurde.
    '        Existiert diese nicht, wird NOTHING zurückgegeben.
    Function TabFeld(Fld As Variant) As ListColumn
      On Error GoTo Err_TabFeld
      Set TabFeld = m_lstTabelle.ListColumns(Fld)
      Exit Function
    Err_TabFeld:
      Set TabFeld = Nothing
    End Function
    
    
    '
    'Eigenschaft "FeldWert: wie Methode "Feld" - gibt jedoch statt eines Zellbereiches
    '        den Wert der Zelle zurück bzw. speichert ihn.
    Property Get FeldWert(Fld As Variant) As Variant
      FeldWert = Feld(Fld).Value
    End Property
    Property Let FeldWert(Fld As Variant, Wert As Variant)
      Feld(Fld).Value = Wert
    End Property
    
    
    
    'Eigenschaft Feldbetrag@: gibt den Währungsbetrag (mit 2 Nk-Stellen) des Feldes "Feld" zurück
    '                         bzw. legt ihn fest
    Property Get FeldBetrag@(Fld As Variant)
      FeldBetrag@ = Nk2@(FeldWert(Fld))
    End Property
    Property Let FeldBetrag(Fld As Variant, Wert@)
      FeldWert(Fld) = Nk2@(Wert@)
    End Property
    
    Private Function Nk2@(Wert)
      Nk2@ = Round(Wert, 2)
    End Function
     
    Zuletzt von einem Moderator bearbeitet: 30. November 2020
    Nelspruit, 27. November 2017
    #5
  6. Exl121150 Erfahrener User
    Hallo,

    die von mir fett unterstrichene Textpassage dürfte/könnte dabei auch das eigentliche Problem darstellen: Die Namensänderung einer solchen "Tabelle" (in VBA ist sie ein "listobject") darf/sollte man nicht über den Namensmanager vornehmen, obwohl der Name dort auch aufscheint (zwar nicht als Bereichsname, sondern als Tabellenname).

    Für diese Namensänderung sollte
    1) man die aktive Zelle irgendwo in den Zellbereich einer solchen Tabelle stellen (eingefärbt im Zebra-Look).
    2) Daraufhin erscheint im Menüband ein zusätzlicher Tabulator "Tabellentools / Entwurf" - diesen Tab "Entwurf" anklicken.
    3) In der Menübandgruppe "Eigenschaften", ganz links in diesem Kontextmenüband, ist im Textfeld "Tabellenname" der Tabellenname "TabVerzeichnis" abzuändern in "Update".
    4) Sieht man danach im Namensmanager nach, so ist auch dort der Namenseintrag umgestellt auf "Update" und zwar gekennzeichnet links davor mit einem Tabellen-Icon (und nicht mit einem Bereichs-Icon).

    Wenngleich man die Namensänderung einer "Tabelle" auch über den Namensmanager vornehmen kann, ist eine Neuanlage einer "Tabelle" über diesen gänzlich unmöglich. - Bitte kontrolliere, ob es sich beim Namen "Update" eh noch um einen Tabellennamen handelt (und nicht doch nur bloß um einen Bereichsnamen).

    In der beigefügten Datei habe ich im Arbeitsblatt "Navigation" die zu ändernden Texte/Namen rot eingefärbt gekennzeichnet. Entscheidend sind hier die Texte in der Tabelle "Update" (Kopf bzw. Datenzeilen).
    Die im Codemodul dieses Blattes enthaltenen Makros habe ich deinen Wünschen gemäß geändert, wobei mir aufgefallen ist, dass du im Fehlerbehandlungsabschnitt ab Sprungmarke "Err_TabVerz_Lesen:" übersehen hast, die Variable "Quellmappe$" auf "Source_path$" umzustellen.

    Das kann man natürlich tun, ist aber nicht unbedingt nötig, falls man, wie du es getan hast, beim Methodenaufruf im Hauptprogramm diesen zweiten (als optional deklarierten) Parameter angibt.
     
    Zuletzt bearbeitet: 28. November 2017
    Exl121150, 28. November 2017
    #6
Thema:

VBA Code-automatisches Kopieren von Excel-Inhalten; unterschiedliche Speicherorte

Die Seite wird geladen...
  1. VBA Code-automatisches Kopieren von Excel-Inhalten; unterschiedliche Speicherorte - Similar Threads - VBA Code automatisches

  2. MS ACCESS Insert into Foto in Datenbank

    in Microsoft Access Hilfe
    MS ACCESS Insert into Foto in Datenbank: Hallo. Ich benutze MS ACCESS im Office 365. Habe eine Anwendung geschrieben, in der in einem Formular ein Foto im Typ Bild dargestellt wird. Ich möchte nun dieses Foto mittels einem "Insert...
  3. Excel VBA Codes Pivot-Aktualisierung, Kommentare, etc.

    in Microsoft Excel Hilfe
    Excel VBA Codes Pivot-Aktualisierung, Kommentare, etc.: Hallo liebe Office-Hilfe Mitglieder, ich bin seit kurzem hier neu registriert und hätte eine (für mich als absolutem Laien in Sachen VBA) Problemstellung, bei der mir hoffentlich jemand von Euch...
  4. Exel Sonderzeichen über VBA in Code einfügen

    in Microsoft Excel Hilfe
    Exel Sonderzeichen über VBA in Code einfügen: Für einen Stammbaum habe ich bisher über 400 Personen in Excel erfasst. Zur schnelleren Suche nach zusammenhängenden Personen werden die wesentlichen Daten in eine ListBox (ListPersonen)...
  5. Excel VBA Code

    in Microsoft Excel Hilfe
    Excel VBA Code: Hallo Vielleicht kann mir hierbei wer helfen? Warum funktioniert der Code nicht? Der IF-Codeteile mit "F", "iA" und "O" funktionieren. Aber wenn ich im userform den Teil mit "TF" aufrufe...
  6. VBA Code für SumIf

    in Microsoft Excel Hilfe
    VBA Code für SumIf: Hallo zusammen, ich benötige bitte einmal eure Hilfe. Ich möchte gerne in Spalte D die erste leere Zelle finden und dort dann die Summe der Spalte D ziehen, aber nur wenn in Spalte A kein Text...
  7. Excel Filter bei VBA berücksichtigen

    in Microsoft Excel Hilfe
    Excel Filter bei VBA berücksichtigen: Hallo zusammen, ich glaube, ich habe ein kniffligeres Problem. Gerne auch neue Ansätze. Ich versuchs kurz und präzise. Der Anwender kreuzt in Spalte F("Auswahl") an, welche Nummern er aus Spalte...
  8. VBA Code ändern um Werte richtig zu holen

    in Microsoft Excel Hilfe
    VBA Code ändern um Werte richtig zu holen: Hallo Zusammen, würde mir bitte jemand das unten stehende Code sozusagen übersetzen ? Eigentlich sollen aus den Zellen J29 S29 AB29 und dann Abstand 35 Zeilen ein Wert geholt werden. Es werden...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden