gibt es die Möglichkeit Zellen nur durch Verschieben auszutauschen. Mit Überschreiben ist das ja möglich, aber ich hätte gern, dass der Inhalt in der alten Zelle eingetragen wird.
Dank für Eure Hilfe.
Gruß
Karsten
Option Explicit
Sub Tauschen()
Dim RnG As Range
Dim StrG1 As String, StrG2 As String
If Selection.Count = 2 Then
For Each RnG In Selection
If StrG1 = "" Then
StrG1 = RnG.Value
Else
StrG2 = RnG.Value
End If
Next
Selection.Value = ""
For Each RnG In Selection
RnG.Value = StrG2
StrG2 = StrG1
Next
End If
End Sub
https://www.herber.de/bbs/user/64570.xls
D | E | F | |
7 | 09:45 | Schäfer, Mathi | 22,5 |
8 | Blfl. | 03560313168 | l |
9 | Groschischka, Laureen | ||
10 | Key. | 03560370076 | n |
11 | 14:30 | Gloede, Elias | 22,5 |
12 | Key. | 61672 | n |
13 | 16:00 | Groschischka, Linda | 45,0 |
14 | Key. | 03560370076 | n |
15 | 09:00 | Piltz, Michael | 45,0 |
16 | Sax. | 03547812383 01715042994 | l |
17 | 16:45 | Zhyzhko, Sascha | 30,0 |
18 | Blfl. | 035603750512 | n |
Sub Tausch()
Dim varW, varL
With Selection
If .Areas.Count = 2 And .Count = 2 Then
varW = .Areas(1).Resize(2, 2)
varL = .Areas(1).Offset(1, -1)
.Areas(1).Resize(2, 2) = .Areas(2).Resize(2, 2).Value
.Areas(1).Offset(1, -1) = .Areas(2).Offset(1, -1).Value
.Areas(2).Resize(2, 2) = varW
.Areas(2).Offset(1, -1) = varL
End If
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub Tausch()
Dim varW, varL, varC As Integer
With Selection
If .Areas.Count = 2 And .Count = 2 Then
varC = .Areas(1).Interior.ColorIndex
varW = .Areas(1).Resize(2, 2)
varL = .Areas(1).Offset(1, -1)
.Areas(1).Offset(, -1).Resize(2, 3).Interior.ColorIndex = _
.Areas(2).Interior.ColorIndex
.Areas(1).Resize(2, 2) = .Areas(2).Resize(2, 2).Value
.Areas(1).Offset(1, -1) = .Areas(2).Offset(1, -1).Value
.Areas(2).Offset(, -1).Resize(2, 3).Interior.ColorIndex = varC
.Areas(2).Resize(2, 2) = varW
.Areas(2).Offset(1, -1) = varL
End If
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub Tausch()
Dim varW
varW = Selection.Areas(1)
If Selection.Count = 2 And Selection.Areas.Count = 2 Then
varW = Selection.Areas(1)
Selection.Areas(1) = Selection.Areas(2)
Selection.Areas(2) = varW
ElseIf Selection.Count = 2 Then
Selection.Cells(1) = Selection.Cells(2)
Selection.Cells(2) = varW
End If
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-LintfortSub Tausch()
Dim rngZWS As Range
With Selection
If .Areas.Count = 2 Then
If .Areas(1).Cells.Count = .Areas(2).Cells.Count And _
.Areas(1).Rows.Count = .Areas(2).Rows.Count And _
.Areas(1).Columns.Count = .Areas(2).Columns.Count Then
Set rngZWS = Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2, . _
column)
.Areas(1).Copy rngZWS
.Areas(2).Copy .Areas(1)
rngZWS.CurrentRegion.Copy .Areas(2)
rngZWS.CurrentRegion.EntireRow.Delete
End If
End If
End With
End Sub
Gruß, DanielSub Tausch()
Dim rngZWS As Range
With Selection
If .Areas.Count = 2 Then
If .Areas(1).Cells.Count = .Areas(2).Cells.Count And _
.Areas(1).Rows.Count = .Areas(2).Rows.Count And _
.Areas(1).Columns.Count = .Areas(2).Columns.Count Then
Set rngZWS = Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2, . _
column)
.Areas(1).Copy rngZWS
.Areas(2).Copy .Areas(1)
rngZWS.CurrentRegion.Copy .Areas(2)
rngZWS.CurrentRegion.EntireRow.Delete
End If
End If
End With
End Sub
Gruß, DanielProblemstellung
Wie kann ich eine Reihe von Unterprogrammen in Abhängigkeit vom Namen der Eingabezelle aufrufen?
Problemstellung
Wie kann ich die Zellen eines ausgewählten Bereiches überprüfen, ob sie einen Kommentar enthalten und wenn ja, diesen ändern?
Problemstellung
Wie kann ich den Text in einer UserForm-Textbox je Zeile auf verschiedene Zellen aufteilen?
Problemstellung
Wie kann ich zwei Spalten verschiedener Arbeitsblätter vergleichen und Übereinstimmungen in beiden Blättern kennzeichnen?
Problemstellung
Wie kann ich die Anzahl aller mit einer vorgegebenen Zellinnenfarbe markierter Zellen eines vorgegebenen Bereiches zählen?
Problemstellung
Wie kann ich Daten aus einer Textdatei gezielt in bestimmte Zellen eines Arbeitsblattes schreiben lassen? Der Feldseparator ist das Komma.
Problemstellung
Wie kann ich bei der Zahleneingabe bei Minuswerten die Zelle schraffieren und die Schraffierung bei Pluswerten wieder aufheben?
Problemstellung
Wie kann ich unterhalb der markierten Zeilen soviel Zeilen einfügen, wie ich markiert habe?