MultiSeek und aktive Zelle kopieren

Forumthread: MultiSeek und aktive Zelle kopieren

15.10.2007 17:20:55

Friedrich,

Hallo Mitdenker,
ich suche mit Hilfe Herbers Suchfunktion 015598h.htm in Tabellen eine Zahl.
Diese gefundene Zahl soll in Spalte AS gleiche Zeile kopiert werden.
015598h.htm
.
.
MsgBox promt:="Keine..............!"
Call Makro200
End Sub

Sub Makro200()
' Makro am 12.10.2007 von Bernd aufgezeichnet
'
' Tastenkombination: Strg+x
' Option Explicit
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("ActiveCell")) Is Nothing Then
Call Makro400
End If
End Sub

Sub Makro400() das ist ähnlich 198803h.htm ohne Löschen und auf das gleiche Worksheet
'Sub Übertragen
Dim iRow As Integer
Dim iColumn As Integer
With Worksheets("ActiveCell")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveCell.EntireColumn("AS").Copy
.Columns.AutoFit
End With
End Sub

Wer kann mir da bitte einmal helfen?
Mit bestem Dank in voraus
friedrich

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: MultiSeek und aktive Zelle kopieren

15.10.2007 20:08:51

Renee
AW: MultiSeek und aktive Zelle kopieren

15.10.2007 21:35:00

Friedrich,

AW: MultiSeek und aktive Zelle kopieren

15.10.2007 20:08:51

Renee

Hi Friedrich,
Kannst Du das ganze in einer Beispielmappe erklären?
Ich versteh nicht einmal Bahnhof !
GreetZ Renee

AW: MultiSeek und aktive Zelle kopieren

15.10.2007 21:35:00

Friedrich,

Hallo Renee,
anbei mein
Sub Suchen()
'StandardModule: basMain
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
Set rng = wks.Cells.Find( _
what:=sFind, _
lookat:=xlWhole, _
LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
If MsgBox( _
prompt:="Weiter", _
Buttons:=vbYesNo + vbQuestion _
) = vbNo Then Exit Sub
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Next wks
Call Makro200
MsgBox prompt:="Keine neue Fundstelle!"
End Sub

Sub Makro200()
' Makro am 12.10.2007 von Bernd aufgezeichnet
'
' Tastenkombination: Strg+x
' Option Explicit
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("ActiveCell")) Is Nothing Then
Call Makro400
End If
End Sub

Sub Makro400()
'Sub Übertragen
Dim iRow As Integer
Dim iColumn As Integer
With Worksheets("ActiveCell")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveCell.EntireColumn("AS").Copy
.Columns.AutoFit
End With
End Sub

Du findest bestimmt die Fehler!
Mit bestem Gruß
friedrich

Beliebteste Forumthreads (12 Monate)

MultiSeek und aktive Zelle kopieren

Forumthread: MultiSeek und aktive Zelle kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread