Datenimport ohne überschreiben
20.08.2014 09:45:23
Knoof
Ich habe vor längerer Zeit mal den folgenden Code bekommen.
Der funktioniert eigentlich ganz gut...
Wenn in meiner Zieldatei schon Datensätze vorhanden sind, fügt er die neuen Datensätze aus meiner Queldatei auch unten an.
Wenn meine Zieldatei allerdings noch keine Datensätze enthält und ich aktualisieren drücke, dann werden die Datensätze einfach ganz weit unten in Zeile 47 oder so eingefügt und die oberen Zeilen bleiben leer.
Ich weiß beim besten willen nicht woran das liegen kann.
Private Sub cmdimport_Click()
Dim Zelle As Range
Dim quRows As Long
Dim zuRows As Long
Dim suche As Range
Dim QWB As Workbook, ZWB As Workbook
Dim qsh As Worksheet, zsh As Worksheet
Dim ordner As Variant
'Wenn die Datei erst geöffnet werden muss
Set ZWB = ThisWorkbook ' Ziel, Workbook mit diesem Makro
Set zsh = ZWB.ActiveSheet ' Ziel
ordner = Application.GetOpenFilename("Manche Dateien (*.txt),*.txt,Alle Dateien,*.*")
Set QWB = Workbooks.Open(ordner) ' Quelle, aus der die Tabelle41 kopiert werden soll
Set qsh = QWB.Worksheets("Sheet 1") ' Quelle
If MsgBox("Nur Update?", vbYesNo) = vbNo Then
qsh.Cells.Copy zsh.Cells(1, 1) ' oder before
Else
'code für update
quRows = qsh.UsedRange.Rows.Count
For Each Zelle In qsh.Range(qsh.Cells(1, 1), qsh.Cells(quRows, 1))
Set suche = zsh.Columns(1).Find(Zelle, , xlValues, xlWhole)
If suche Is Nothing Then
'zeile wird ins zielsheet unten angefügt
Zelle.EntireRow.Copy zsh.Cells(zsh.UsedRange.Rows.Count + 1, 1)
End If
Next
End If
QWB.Close ' Wenn die Datei wieder geschlossen werden soll
End Sub
Ebenso sollen die Überschriften der Spalten nicht überschrieben werden, es sollen lediglich Datensätze die noch nicht vorhanden sind einfach in mein Zielsheet eingefügt werden, und wenn mien Zielsheet leer ist(nur überschriften), dann sollen halt alle eingefügt werden.Bitte um Hilfe!
Gruß,
Knoof