nur freigegebene Zellen kopieren

Forumthread: nur freigegebene Zellen kopieren

Stefan

Hallo Zusammen,
habe ein kleines Problem...
Möchte gerne aus einer Alten XLS eine Spalte 8 in die neue XLS übernehmen.
Bringt mir jedoch eine Fehlermeldung.
Grund: es gibt in der Spalte einige Zeilen die schreibgeschützt sind.
Wie kann ich nur die nicht gesperrten Zellen kopieren ?
Hier mein Code:
.Cells(Zeile_Alt, 8).Copy _
Destination:=wks_Streckenkopf_Neu.Cells(Zelle_Wert_B.Row, 8)
Gruß
Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: nur freigegebene Zellen kopieren

10.08.2010 09:04:57

Henrik

Hallo Stefan,
meinst du so?


For zae1 = 20 To 30
With ThisWorkbook.Worksheets("Tabelle1")
If .Cells(zae1, 8).AllowEdit = False Then
Else
.Cells(zae1, 8).Copy
ThisWorkbook.Worksheets("Tabelle2").Cells(zae1, 8).PasteSpecial (xlPasteValues)
End If
End With
Next zae1

oder so, wenn du die nicht gesperrten Bereiche kennst. Einfach die zu kopierenden Bereiche vorgeben.

.Range("F2:F7,F11:F17,F20,F23,F27:F30").Copy

Gruß Henrik

AW: nur freigegebene Zellen kopieren

10.08.2010 09:15:05

Stefan

Hi,
danke für die schnelle Antwort...
Was: 2 Tabellen (alt & neu) aus alt soll wenn Spalte B gleich ist bestimmte Spalten kopiert werden.
Problem: Immer wieder sind zwischendrin Zeilen die schreibgeschützt sind.
D.h. es sollen nur die freigegeben Zellen kopiert werden..
Hier ist mein Teil Code:
With wks_Streckenkopf_Alt
For Zeile_Alt = 17 To 53
'Wert in Altdatei-Spalte A
vWert_B = .Cells(Zeile_Alt, 2).Value
If vWert_B "" Then
'Wert in neuer Datei Spalte B suchen
With wks_Streckenkopf_Neu
Set Zelle_Wert_B = .Range(.Cells(17, 2), .Cells(53, 2)) _
.Find(what:=vWert_B, LookIn:=xlValues, lookat:=xlWhole)
End With
If Zelle_Wert_B Is Nothing Then 'Wert in neuer Vorlage nicht vorhanden
If wks_diff Is Nothing Then
'Tabellenblatt für Abweichungen anlegen
Set wks_diff = wbNeu.Worksheets.Add(After:=wks_Grunddaten_Neu)
wks_diff.Name = "Streckenkopf-Diff"
'Spaltenbreiten in Differenzblatt an Alt-Datei anpassen
For Spalte = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column
wks_diff.Columns(Spalte).ColumnWidth = .Columns(Spalte).ColumnWidth
Next
End If
Zeile_Diff = Zeile_Diff + 1
.Rows(Zeile_Alt).Copy Destination:=wks_diff.Cells(Zeile_Diff, 2)
Else
'Werte aus Spalten H von Alt nach Neu kopieren
.Cells(Zeile_Alt, 8).Copy _
Destination:=wks_Streckenkopf_Neu.Cells(Zelle_Wert_B.Row, 8)
'Werte aus Spalten M:N von Alt nach Neu kopieren
.Range(.Cells(Zeile_Alt, 13), .Cells(Zeile_Alt, 14)).Copy _
Destination:=wks_Streckenkopf_Neu.Cells(Zelle_Wert_B.Row, 13)
End If
End If
Next
End With
in dem fett gekennzeichneten Teil sollen aber nur die Freigegeben Zellen kopiert werden...
Könntest du mir das anhand dieses Beispieles zeigen ?
:-)
Stefan

AW: nur freigegebene Zellen kopieren

10.08.2010 09:45:19

Henrik

Hallo Stefan,
ersetz den fetten Bereich mal hiermit.


'Kontrolliert, ob das editieren der Zelle erlaubt ist.
'Wenn gesperrt dann nix machen.
If .Cells(Zeile_Alt, 8).AllowEdit = False Then
Else
'Werte aus Spalte H von Alt kopieren
.Cells(Zeile_Alt, 8).Copy
'Diese Werte in Neu Spalte 8 = H einfügen
wks_Streckenkopf_Neu.Cells(Zelle_Wert_B.Row, 8).PasteSpecial (xlValues)
'Werte aus Spalte M:N von Alt kopieren
.Range(.Cells(Zeile_Alt, 13), .Cells(Zeile_Alt, 14)).Copy
'Diese Werte in Neu Spalte 13 = M einfügen
wks_Streckenkopf_Neu.Cells(Zelle_Wert_B.Row, 13).PasteSpecial (xlValues)
End If

Henrik

AW: nur freigegebene Zellen kopieren

10.08.2010 10:04:04

Stefan

Danke Henrik,
funktioniert !
:-)
Stefan

Beliebteste Forumthreads (12 Monate)

Forumthread: nur freigegebene Zellen kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

nur freigegebene Zellen kopieren

Forumthread: nur freigegebene Zellen kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread