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 SubMit 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