Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1240to1244
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

ohne Select

ohne Select
Karsten
Hallo,
ich möchte u.st. Code ausführen ohne die Seite zu wechseln, bekomme es aber nicht hin. Kann mir jemand dabei helfen?
Danke
Gruß
Karsten
Sheets("Autokorrektur").Select
Range("D1:D4").Select
ActiveSheet.Paste
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Bold = True
Selection.Font.Bold = False
Range("C1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[1],1,3)"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[1],1,4)"
Range("C3").Select
ActiveCell.FormulaR1C1 = "=MID(RC[1],1,5)"
Range("C4").Select
ActiveCell.FormulaR1C1 = "=MID(RC[1],1,6)"
Range("C1:D4").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1:B4").Select
Selection.Copy
Dim LetzteZelle As Long
LetzteZelle = Range("a5").End(xlDown).Row
Cells(LetzteZelle, 1).Activate
With ActiveCell
Range(.Offset(1, 0), .Offset(1, 0)).Select
End With
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("a1:D4").Select
Selection.Clear

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: ohne Select
12.12.2011 09:21:51
Hajo_Zi
Hallo Karsten,
da fehlt Leider der Beginncode, das starten des kopieren.

AW: ohne Select
12.12.2011 09:28:37
Karsten
Hallo Hajo,
Selection.Copy
danach habe ich den besagten Code abgespult.
Gruß
Karsten
AW: ohne Select
12.12.2011 09:32:09
Hajo_Zi
Hallo Karsten,
ich habe die Datei nicht nachgebaut. Ich hoffe ich habe alles richtig verstanden.
Option Explicit
Sub Test()
Dim LetzteZelle As Long
Selection.Copy Sheets("Autokorrektur").Range("D1:D4")
With Sheets("Autokorrektur")
With .Range("D1:D4")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Font.Bold = True
.Font.Bold = False
End With
.Range("C1").FormulaR1C1 = "=MID(RC[1],1,3)"
.Range("C2").FormulaR1C1 = "=MID(RC[1],1,4)"
.Range("C3").FormulaR1C1 = "=MID(RC[1],1,5)"
.Range("C4").FormulaR1C1 = "=MID(RC[1],1,6)"
.Range("C1:D4").Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
.Range("A1:B4").Copy
LetzteZelle = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, _
.Rows.Count)
If LetzteZelle > 5 Then LetzteZelle = 5
With Cells(LetzteZelle, 1)
.Range(.Offset(1, 0), .Offset(1, 0)).Select
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose: _
=False
End With
.Range("a1:D4").Clear
End With
Application.CutCopyMode = False
End Sub

Gruß Hajo
Anzeige
AW: ohne Select
12.12.2011 10:26:23
Karsten
Hallo Hajo,
danke, aber da läuft noch einiges gegen den Baum. Z.B. wird dies in der gerade akt. Tabelle ausgeführt.
Ich hab nun schon:
With Sheets("Autokorrektur")
....
End With
Aber es hilft nicht.
Gruß
Karsten
LetzteZelle = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
If LetzteZelle > 5 Then LetzteZelle = 5
With Cells(LetzteZelle, 1)
.Range(.Offset(1, 0), .Offset(1, 0)).Select
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End With
Anzeige
AW: ohne Select
12.12.2011 10:30:22
Hajo_Zi
Hallo Karsten,
ich vermute das siehst Du falsch. In Vba kann auf Select usw. zu 99,9% verzichtet werden. Es werden die Aktionen nicht in der aktuellen Tabelle ausgeführt. Da bin im mir ziemlich sicher.
Zu dem Ps schreibe ich nichts, da war ja keine Frage.
Gruß Hajo
AW: ohne Select
12.12.2011 10:38:38
Karsten
Hallo Hajo,
In Vba kann auf Select usw. zu 99,9% verzichtet werden.
Das will ich ja nicht bestreiten. Aber mit:
With Sheets("Autokorrektur")
LetzteZelle = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
If LetzteZelle > 5 Then LetzteZelle = 5
With Cells(LetzteZelle, 1)
.Range(.Offset(1, 0), .Offset(1, 0)).Select
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End With
geht es offenbar nicht. Um 'ne Frage draus zu machen - kannst du es richtig adressieren?
Gruß
Karsten
Anzeige
AW: ohne Select
12.12.2011 10:40:18
Hajo_Zi
Hallo Karsten,
With .Cells(LetzteZelle, 1)
Gruß Hajo
AW: ohne Select
12.12.2011 10:48:58
Karsten
Hallo Hajo,
ok. Und was ist damit? Das braucht doch irgendwo den Führer. Wo steht da auf welcher Tab es ausgeführt werden soll?
Dim LetzteZelle As Long
LetzteZelle = Range("a5").End(xlDown).Row
Gruß
Karsten
AW: ohne Select
12.12.2011 10:53:23
Hajo_Zi
Hallo Karsten,
schaue in meinen letzten Beitrag.
Die 2. Zeile finde ich nicht ich habe Extra Strg+F benutzt
Gruß Hajo
Anzeige
AW: ohne Select
12.12.2011 10:45:12
Hajo_Zi
Hallo Karsten,
ich habe ein select noch übersehen.
Option Explicit
Sub Test()
Dim LetzteZelle As Long
Selection.Copy Sheets("Autokorrektur").Range("D1:D4")
With Sheets("Autokorrektur")
With .Range("D1:D4")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Font.Bold = True
.Font.Bold = False
End With
.Range("C1").FormulaR1C1 = "=MID(RC[1],1,3)"
.Range("C2").FormulaR1C1 = "=MID(RC[1],1,4)"
.Range("C3").FormulaR1C1 = "=MID(RC[1],1,5)"
.Range("C4").FormulaR1C1 = "=MID(RC[1],1,6)"
.Range("C1:D4").Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
.Range("A1:B4").Copy
LetzteZelle = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, _
.Rows.Count)
If LetzteZelle > 5 Then LetzteZelle = 5
.Range(.Cells(LetzteZelle, 1).Offset(1, 0), .Cells(LetzteZelle, 1).Offset(1, 0)). _
PasteSpecial
.Range("a1:D4").Clear
End With
Application.CutCopyMode = False
End Sub
Gruß Hajo
Anzeige
AW: ohne Select
12.12.2011 10:48:49
Hajo_Zi
Hallo Karsten,
und noch ein.
Option Explicit
Sub Test()
Dim LetzteZelle As Long
Selection.Copy Sheets("Autokorrektur").Range("D1:D4")
With Sheets("Autokorrektur")
With .Range("D1:D4")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Font.Bold = True
.Font.Bold = False
End With
.Range("C1").FormulaR1C1 = "=MID(RC[1],1,3)"
.Range("C2").FormulaR1C1 = "=MID(RC[1],1,4)"
.Range("C3").FormulaR1C1 = "=MID(RC[1],1,5)"
.Range("C4").FormulaR1C1 = "=MID(RC[1],1,6)"
.Range("C1:D4").Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
.Range("A1:B4").Copy
LetzteZelle = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, _
.Rows.Count)
If LetzteZelle 
Gruß Hajo
Anzeige
AW: ohne Select
12.12.2011 10:50:53
Hajo_Zi
Hallo Karsten,
es scheint nicht mein Tag zu sein.
Option Explicit
Sub Test()
Dim LetzteZelle As Long
Selection.Copy Sheets("Autokorrektur").Range("D1:D4")
With Sheets("Autokorrektur")
With .Range("D1:D4")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Font.Bold = True
.Font.Bold = False
End With
.Range("C1").FormulaR1C1 = "=MID(RC[1],1,3)"
.Range("C2").FormulaR1C1 = "=MID(RC[1],1,4)"
.Range("C3").FormulaR1C1 = "=MID(RC[1],1,5)"
.Range("C4").FormulaR1C1 = "=MID(RC[1],1,6)"
.Range("C1:D4").Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A1:B4").Copy
LetzteZelle = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, _
.Rows.Count)
If LetzteZelle 

Gruß Hajo
Anzeige
AW: ohne Select
12.12.2011 11:00:15
Karsten
Doch scheint ...jetzt. (Wir versagen alle mal o:) )
Danke für den schnellen Diernst. Bei meinem Talent hab ich's nicht mal bis zur Hälfte geschafft. Bloß gut, dass ich kopieren kann.
Gruß
Karsten
AW: ohne Select
12.12.2011 09:37:56
guentherh
Hallo Karsten,
Die Zellen eindeutig Adressiern, dann brauchts kein Select
Dim LetzteZelle As Long
'Sheets("Autokorrektur").Select
'Range("D1:D4").Select
'ActiveSheet.Paste
Sheets("Autokorrektur").Range("D1:D4").Paste
withSheets("Autokorrektur").Range("D1:D4")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Font.Bold = True
.Font.Bold = False
end with
with Sheets("Autokorrektur")
.Range("C1").FormulaR1C1 = "=MID(RC[1],1,3)"
'Range("C2").Select
.Range("C2").FormulaR1C1 = "=MID(RC[1],1,4)"
'Range("C3").Select
.Range("C3").FormulaR1C1 = "=MID(RC[1],1,5)"
'Range("C4").Select
.Range("C4").FormulaR1C1 = "=MID(RC[1],1,6)"
.Range("C1:D4").Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _ Transpose:=False
.Range("A1:B4").Copy
LetzteZelle = .Range("a5").End(xlDown).Row
'Cells(LetzteZelle, 1).Activate
'With ActiveCell
.Cells(LetzteZelle+1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _ Transpose:=False
'End With
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("a1:D4").Clear
Hoffe ich habe mich nirgends vertippt.
Gruß,
Günther
Anzeige
AW: ohne Select
12.12.2011 10:28:53
Karsten
Hallo guentherh,
danke, aber es werden einige Dinge so nicht unterstützt.
Z.B.
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
Gruß
Karsten

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige