AW: Zellwerte auf 3 Zellen übertragen
15.07.2012 19:22:14
Erich
Hi Mehmet,
schau dir das mal an:
Option Explicit
'Erich G. aus Kamp-Lintfort
Sub Uebertrag2()
Dim lngLast As Long, lngZ As Long, var92 As Variant
With Worksheets("Tabelle1") ' in dieser Tabelle
lngLast = .Cells(.Rows.Count, 92).End(xlUp).Row ' Letzte Zeile in Spalte 92=CN
If lngLast > .Cells(.Rows.Count, 93).End(xlUp).Row Then _
lngLast = .Cells(.Rows.Count, 93).End(xlUp).Row ' oder letzte Z.in Sp.93=CO
For lngZ = 4 To lngLast ' Schleife über Zeilen in CN:CO
' wenn CNnn und COnn nicht leer sind
If .Cells(lngZ, 92) "" And .Cells(lngZ, 93) "" Then
var92 = .Cells(lngZ, 92) ' merke den Wert in CNnn
.Cells(lngZ, 93).Copy ' Kopiere Zelle COnn (wg. der Formate)
With .Range(.Cells(lngZ, 93).Value) ' Zielzelle (steht in COnn)
' übertrage Formate in Zielzelle + zwei Spalten
.Resize(, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone
.Value = var92 ' gemerkter Wert aus CNnn kommt in Zielzelle
End With
End If
Next lngZ
Application.CutCopyMode = False ' Ende des Kopiermodus
.Cells(lngLast + 2, 92).Select ' damit nicht der letzte Zielbereich markiert ist
End With
End Sub
Sub Uebertrag_Entfernen()
With Worksheets("Tabelle1") ' in dieser Tabelle
Range("D2:BY50").Clear ' ohne Select!
End With
End Sub
Sub Uebertrag_EntfernenALT()
Range("D2:BY50").Select
Selection.ClearContents
Selection.Clear
End Sub
Uebertrag_EntfernenALT kannst du wegwerfen.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich