Quelltext umgestalten
09.02.2004 13:20:36
Daniel
Nochmal eine kleine Frage an die Excel-Profis :)! Wie muss ich den unten stehenden Quelltext ummodellieren, wenn das Makro nur (!) den Wert 3 Spalten weiter rechts kopieren soll, wenn in der Zelle 2 (!) Spalten weiter rechts (vom gleichen Ausgangspunkt) ein Wert vorhanden ist?!
Sub Übertragen()
Application.ScreenUpdating = False
Dim rngFind As Range
Dim strFind As String
Dim iRow As Integer
Worksheets("Extrakte2").Activate
Set rngFind = Cells.Find(what:=Range("F1").Value, after:=ActiveCell, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rngFind Is Nothing Then
firstaddress = rngFind.Address
Do
Set rngFind = Cells.FindNext(rngFind)
If rngFind Is Nothing Then
MsgBox "Daten wurden nicht gefunden!"
Exit Sub
End If
rngFind.Select
With Worksheets("Bericht")
ActiveCell.Offset(0, 3).Copy Worksheets("Bericht").[E65536].End(xlUp).Offset(1, 0)
End With
Loop While Not rngFind Is Nothing And rngFind.Address <> firstaddress
End If
Worksheets("Bericht").Activate
Application.ScreenUpdating = True
Columns("E:E").Select
Range("E55").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("E7").Select
Übertragen2
Übertragen3
End Sub
Danke für eure Hilfe!!!
Gruß Daniel
Anzeige