Bei einigen Spalte nur leere Felder füllen
23.08.2016 11:21:07
Rene
ich bin am verzweifeln, der Code funktioniert nicht ganz so wie er soll :( .
Ich möchte gern Spalten von einer Tabelle in eine andere übertragen dies funktioniert auch ohne Probleme, nun habe ich aber einige Spalten, wo nur die geleerten Spalten gefüllt werden sollen und nicht die vorhanden überschrieben werden.
Der Code füllt die Spalten teilweise lässt aber auch einige leer.
Anbei der Code:
Private Sub CommandButton7_Click()
' Daten werden kopiert und in eine andere Datei kopiert.
Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Const Pfad = "L:\VPTA-Zeitmessung\06 Vorbereitung VPTA\"
Const Datei = "151202_LIST_Vorbereitung_Liste_TEST.xlsx"
Set WB1 = ThisWorkbook
Set WB2 = Workbooks.Open(Pfad & Datei)
Set WS1 = WB1.Worksheets("Vorbreitung_VPTA")
Set WS2 = WB2.Worksheets("Tabelle1")
WS1.Range("D3:D999").Copy WS2.Range("A3")
WS1.Range("E3:E999").Copy WS2.Range("B3")
'Nur die Zellen werden überschrieben die noch nicht gefüllt sind
If WS2.Range("C3").Text = "" Then
WS1.Range("F3:F999").Copy
WS2.Range("C3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
End If
WS1.Range("G3:G999").Copy WS2.Range("D3")
WS1.Range("H3:H999").Copy WS2.Range("E3")
WS1.Range("I3:I999").Copy WS2.Range("F3")
WS1.Range("J3:J999").Copy
WS2.Range("G3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
WS1.Range("K3:K999").Copy WS2.Range("H3")
WS1.Range("L3:L999").Copy WS2.Range("I3")
WS1.Range("M3:M999").Copy WS2.Range("J3")
WS1.Range("N3:N999").Copy WS2.Range("K3")
'Nur die Zellen werden überschrieben die noch nicht gefüllt sind
If WS2.Range("O3").Text = "" Then
WS1.Range("S3:S999").Copy
WS2.Range("P3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
End If
WS1.Range("T3:T999").Copy WS2.Range("Q3")
WS1.Range("V3:V999").Copy
WS2.Range("S3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
WB2.Close savechanges:=True
End Sub
Es geht einmal um Spalte C und O in der Zieldatei.
Habe auch schon andere Varianten ausprobiert funktioniert genauso wenig.
Ich hoffe ihr könnt mir ein Denkanstoß geben.
mfg Rene
