Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1504to1508
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Gefüllte Spalten sollen nicht überschrieben werden

Gefüllte Spalten sollen nicht überschrieben werden
14.07.2016 13:18:20
Rene

Hallo zusammen,
ich habe ein Code der eine Tabelle in die andere Datei kopiert.
Aber Spalte C und Spalte O sollen nicht mehr überschrieben werden, die schon gefüllt sind. Habt ihr eine Idee?

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")
WS1.Range("F3:F999").Copy
WS2.Range("C3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
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")
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("Q3:Q999").Copy WS2.Range("N3")
WS1.Range("R3:R999").Copy
WS2.Range("O3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
WS1.Range("S3:S999").Copy WS2.Range("P3")
WS1.Range("U3:U999").Copy
WS2.Range("R3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
WB2.Close savechanges:=True
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: einfach so ....
14.07.2016 15:28:40
If WS2.Range("C3") = Empty then
WS1.Range("F3:F999").Copy
WS2.Range("C3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
End if
If WS2.Range("=3") = Empty then ....
AW: einfach so ....
14.07.2016 17:43:00
Rene
Super danke :)
AW: einfach so ....
14.07.2016 17:49:05
Rene
Okay,
jetzt füllt er die Spalten garnicht mehr :(
Bleiben immer leer.
Anbei der eingesetzte 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")
If WS2.Range("C3") = Empty 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")
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("Q3:Q999").Copy WS2.Range("N3")
If WS2.Range("O3") = Empty Then
WS1.Range("R3:R999").Copy
WS2.Range("O3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
End If
WS1.Range("S3:S999").Copy WS2.Range("P3")
WS1.Range("U3:U999").Copy
WS2.Range("R3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
WB2.Close savechanges:=True
End Sub

Anzeige
AW: einfach so ....
15.07.2016 01:10:21
fcs
Hallo Rene,
probiere es mal so:
    If IsEmpty(WS2.Range("C3")) Then

oder
    If WS2.Range("C3").Text = "" Then

Gruß
Franz
AW: einfach so ....
17.07.2016 15:28:42
wenn die Lösung von Franz auch nicht klappt bitte prüfen
ob noch ein Space " " (Leerzeichen) in der Zelle ist??
Dann mit Trim() arbeiten: -alle Space löschen-
If Trim(WS2.Range("C3")) = Empty Then
AW: einfach so ....
19.07.2016 17:31:03
Rene
Hallo zusammen,
Vielen Dank für die Tipps, er ersetzt die alten Einträge nicht mehr aber er trägt in den entsprechenden Spalten nichts ein, die Zellen bleiben 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")
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("Q3:Q999").Copy WS2.Range("N3")
'Nur die Zellen werden überschrieben die noch nicht gefüllt sind
If WS2.Range("O3").Text = "" Then
WS1.Range("R3:R999").Copy
WS2.Range("O3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
End If
WS1.Range("S3:S999").Copy WS2.Range("P3")
WS1.Range("U3:U999").Copy
WS2.Range("R3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
WB2.Close savechanges:=True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige