Stefan's Weblog

27Jul/170

Werte Kopieren von Quell- in Ziel-Tabelle

Mit diesem Makro lassen sich sehr leicht Werte aus einer Quelle in ein Ziel kopieren.

    >

  • Es wird für jede definierte Rage (Spalte) die letze beschriebene Zeile ermittelt.
  • In die Tabelle Ziel wird eine Formel für den Übertrag der Werte aus Ziel eingetragen.
  • Die Formeln werden nach erfolgreichem übertrag überschrieben.

Quelle

Ziel

Sub KopiereABASUsersOrg()
'
' Kopiert die Orginalwerte aus Quelle in Ziel
'

Application.ScreenUpdating = False

' Tabelle: Quelle     ' Source
' Tabelle Ziel: Ziel    ' Ziel
' Kopiere das Austrittsdatum aus den PMS-Daten-Rohdaten
'
    ' Ermittelt die letzte befüllte Zelle der Tabelle Ziel
    Dim Letzte As Long
    Worksheets("Ziel").Activate
    Letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    ' Ermittelt die letzte befüllte Zelle der Tabelle Ziel
   
    ' Ermittelt die letzte befüllte Zelle der Tabelle Quelle
    Dim quelle_letzte As Long
    Worksheets("Quelle").Activate
    quelle_letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    ' Ermittelt die letzte befüllte Zelle der Tabelle Quelle


    ' B3 - Schreibt die Formel in die Zelle
    Worksheets("Ziel").Range("B3").FormulaLocal = _
    "=WENN('Quelle'!B3="""";"""";'Quelle'!B3)"
        ' Kopiert die Formel ans Ende der Spalte
    Worksheets("Ziel").Activate
    Range("B3").AutoFill Destination:=Range("B3:B" & quelle_letzte), Type:=xlFillDefault
    
    ' D3 - Schreibt die Formel in die Zelle
    Worksheets("Ziel").Range("C3").FormulaLocal = _
    "=WENN('Quelle'!C3="""";"""";'Quelle'!C3)"
        ' Kopiert die Formel ans Ende der Spalte
    Worksheets("Ziel").Activate
    Range("C3").AutoFill Destination:=Range("C3:C" & quelle_letzte), Type:=xlFillDefault
    

    
    Letzte = 0
    quelle_letzte = 0

Call FormelnEntfernen

Application.ScreenUpdating = True
End Sub

Mit diesem Makro können die gesetzten Formeln in der Tabelle "Ziel" entfernt werden.

Private Sub FormelnEntfernen()
'
' Kopiert die Werte in Tabelle "Ziel", um die Formeln zu ersetzen
'

Application.ScreenUpdating = False

 Worksheets("Ziel").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

hat dir dieser Artikel gefallen?

Dann abonniere doch diesen Blog per RSS Feed!

Kommentare (0) Trackbacks (0)

Zu diesem Artikel wurden noch keine Kommentare geschrieben.


Leave a comment

Noch keine Trackbacks.

%d Bloggern gefällt das: