Daten zwischen Files kopieren und abgleichen
Thomas
ich möchte von einem Excel-File Daten in ein anderes (Master)File kopieren und zwar per VBA.
Da ich nur rudimentäre VBA-Kenntnisse besitze habe ich mir etwas Code zusammenkopiert.
Es funktioniert, dass die Einträge einer Spalte in die nächste freie Zelle der Zielspalte im Masterfile
kopiert werden.
Es werden allerdings auch die leeren Zellen mitkopiert. Der untere Teil sollte nun eigentlich prüfen, ob der Eintrag schon vorhanden ist und nachfragen: Überschreiben, Überspringen oder Abbrechen?
Das fx nicht.
Wie kann ich definieren, dass nur beschriebene Zellen kopiert und dann mit den Daten im Masterfile abgeglichen werden?
Vielen Dank+Grüße,
Thomas
Option Explicit
Sub Kopieren()
Dim Vergleich
Dim Bereich As Range
Dim Quelle As Workbook
Dim Ziel As Workbook
Dim i As Integer
Set Quelle = ActiveWorkbook
Set Ziel = Workbooks("Verwaltung.xlsm")
Set Bereich = Range(ActiveSheet.UsedRange.Address)
Vergleich = Range("A1")
Ziel.Sheets("Tabelle1").Activate
If Pruefen(Vergleich) Then
Quelle.Sheets("TabelleX").Range("A32:A42").Copy
Ziel.Sheets("Tabelle1").Range("A1").Activate
i = Cells(Rows.Count, 1).End(xlUp).Row
Cells(i + 1, 1).Select
Selection.PasteSpecial xlPasteValues
Quelle.Activate
Application.CutCopyMode = False
End If
Set Quelle = Nothing
Set Ziel = Nothing
Set Bereich = Nothing
End Sub
Function Pruefen(Pruefwert) As Boolean
Dim rngPruef As Range
Dim rngZelle As Range
Set rngPruef = Range("A1:A256")
For Each rngZelle In rngPruef
If Pruefwert = rngZelle Then
If MsgBox(rngZelle & " ist bereits vorhanden. Trotzdem kopieren?", vbYesNo + vbQuestion, _
"Datenkonflikt") = vbYes Then
Pruefen = True
End If
Exit For
End If
Next
Set rngPruef = Nothing
End Function