VBA funktioniert nicht

[Frogger1986]

hallo

mein VBA- Code funktioniert nur jedes 2. mal kann mir jemand helfen?

[MisterBurns]

Womöglich kann das jemand, wenn du eine Beispieldatei postest. Niemand hat Lust, deine Datei nachzubauen. Und schon gar nicht, den Code abzutippen.

[Frogger1986]

dafür tut der code zu viel, um eine datei nachzubauen aber ich kann den code in eine tabelle ablegen!

[Käpt'n Blaubär]

Hallo,

da Du nur ein Bild gezeigt hast, läßt sich der Code nicht anfassen und ich habe keine Lust,
ihn in den Editor zu schreiben.

Was mir aufgefallen ist, Copy & Paste gehören zusammen. Du jedoch hast andere Befehle, Anweisungen usw.
dazwischengequetscht. Das allein kann es aber nicht sein, weil Du ja schreibst, daß der Code auch durchzulaufen
in der Lage ist.
Bildbetrachtung im Forum ... das macht, zumindest mir, nicht so wirklich Spaß.

[MisterBurns]

Mit dem Code alleine fange ich nichts an. Es wären auch Beispieldaten schön, damit man den Code auch anwenden kann. 20 Zeilen reichen ja schon.
Wichtig ist, dass die Datei gleich aufgebaut ist.

[snb]

Stimmt der Überschrift der Thread wohl ? oder gibt es etwas anderes das nicht funktioniert ?

[Frogger1986]

Hier die Gebastelte Beispieldatei

[Steffl]

Hallo,

mal ungetestet (und auf das Select verzichtet)

Code:

Sub Setze_Lager_85_Fest_in_Lager_85_k()
'
' Setze_Lager_85_Fest_in_Lager_85_k
   Dim lngC As Long
    
    Sheets("Lager 85").Visible = True
    Sheets("Lager 85").Range("A2:B1500").Copy
    Sheets("Lager 85").Visible = False
    With Worksheets("Lager 85 k")
    .Unprotect 1144
    'erste freie Zeile im Tabellenblatt Lager 85 k suchen
    lngC = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    .Cells(lngC, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'    Columns("B:C").Select
    Application.CutCopyMode = False
    .Range("$B$1:$C$5000").RemoveDuplicates Columns:=1, Header _
        :=xlYes
    .Range("$B$1:$B$1500").HorizontalAlignment = xlCenter
    .Range("$c$1:$c$1500").HorizontalAlignment = xlLeft
    .Protect 1144
    End With
    


End Sub

[Frogger1986]

Das geht so leider nicht, da das Kopierte in Spalte 2 muss und der Fehler bleibt auch!

[Steffl]

Hallo,

Das geht so leider nicht, da das Kopierte in Spalte 2 muss

Anstatt so

Code:

.Cells(lngC, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

mache es so

Code:

.Cells(lngC, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False