Erst mal vielen Dank an alle- die hier in ihrer Freizeit anderen helfen. Ich konnte mir hier schon sehr viel Wissen aneignen. Doch leider zerstöre ich mir oft durch meine Bastelei meine Werke. Aber aller Anfang ist schwer!
Problem:
ich Kopiere mittels einer Anweisung Teile meiner "Tabelle1" in eine Tabelle "Bearbeitung"- dort Bearbeite ich einige Zeilen - und Kopiere sie mit folgender Anweisung zurück.
Beim Zurückkopieren aber tritt an folgender Stelle ein Fehler auf, mit einem Hinweis über verbundene Zellen.
Ws1.Cells(last, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Kann man beim "zurück Kopieren" die Anweisung geben- nur Inhalte einfügen?
glaube dann wäre die Fehlermeldung weg.
Sub Von_Bearbeitung_nach_Tabelle1()
Dim Zeile As Long
Dim Zeile2 As Long
Dim StartZeile As Long
Dim last As Long
Dim arr
Dim x As Long
Dim y As Long
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets("Tabelle1")
Set Ws2 = ThisWorkbook.Worksheets("Bearbeiten")
Application.ScreenUpdating = False
last = 20 ' Start von Tabelle 1
StartZeile = 1 ' Start von Bearbeitung
x = 0
y = 0
arr = Array(30, 19, 30, 19) ' JA,NEIN,JA,NEIN
Zeile = StartZeile
Zeile2 = StartZeile
Do
If Zeile > 5000 Then Exit Do
If Not x Mod 2 0 Then
Zeile2 = Zeile2 + arr(x) - 1 + y
Ws2.Rows(Zeile & ":" & Zeile2).EntireRow.Copy
Ws1.Cells(last, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
_
Transpose:=False
last = last + arr(x)
Zeile = Zeile + arr(x)
Else
last = last + arr(x)
End If
y = 1
If x = UBound(arr) Then x = 0: GoTo xx
x = x + 1
xx:
Loop
Application.ScreenUpdating = True
End Sub