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ß, Daniel