Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1512to1516
1512to1516
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bitte um kleine VBA Hilfe

Forumthread: Bitte um kleine VBA Hilfe

Bitte um kleine VBA Hilfe
02.09.2016 10:15:17
Micha
Hallo liebe Spezialisten,
ich benötige Eure VBA Unterstützung.
Wie muss der VBA Code aussehen wenn:
Die aktivierte Zelle soll eine Zeile tiefer kopiert werden, aber nur wenn in Spalte A kein „x“ steht.
Falls dort doch ein „x“ steht soll der kopierte Inhalt erst in die nächste freie Zeile eingefügt werden.
Freue mich auf Eure Unterstützung.
Gruß, Micha
Tabelle1
 ABCDEF
1  Text-1Text-2     
2  Text-1       
3x         
4x         
5x         
6x         
7  Text-1       
8  Text-1       
9  Text-1       
10  Text-1       
11  Text-1       
12  Text-1       
13x         
14x         
15x         
16x         
17x         
18x         
19  Text-1       
20  Text-1       
21  Text-1       
22  Text-1       
23           
24           
25           
26x         
27x         

Tabellendarstellung in Foren Version 5.47


Anzeige

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bitte um kleine VBA Hilfe
02.09.2016 10:39:40
Herbert
Hallo Micha,
probiers mal damit (der zu kopierende Text, und damit auch der Cursor, steht in Spalte C):
Sub testcopy()
check_x:
iCount = iCount + 1
If ActiveCell.Offset(iCount, -2).Range("A1").Value = "x" Then
GoTo check_x
Else
ActiveCell.Offset(iCount, 0).Range("A1").Value = ActiveCell.Value
End If
End Sub
Servus
Anzeige
AW: Bitte um kleine VBA Hilfe
02.09.2016 10:48:54
Micha
Hallo Herbert,
in Spalte "C" funktioniert das soweit gut.
Die Funktion soll aber im gesamten Tabellenblatt anzuwenden sein.
Danke für weitere Hilfe
VG, Micha
AW: Bitte um kleine VBA Hilfe
02.09.2016 11:08:49
Herbert
Hallo Micha,
dann nimm das hier:

Sub testcopy2()
check_x:
iCount = iCount + 1
If ActiveCell.Offset(iCount, -ActiveCell.Column + 1).Range("A1").Value = "x" Then
GoTo check_x
Else
ActiveCell.Offset(iCount, 0).Range("A1").Value = ActiveCell.Value
End If
End Sub
Servus
Anzeige
AW: Bitte um kleine VBA Hilfe
02.09.2016 11:49:32
Herbert
Hallo Micha,
es geht auch noch eleganter:
Sub testcopy()
Dim iCount As Long
Do While ActiveCell.Offset(iCount, -ActiveCell.Column + 1).Range("A1").Value = "x"
iCount = iCount + 1
Loop
ActiveCell.Offset(iCount, 0).Range("A1").Value = ActiveCell.Value
End Sub
Servus
Anzeige
AW: Bitte um kleine VBA Hilfe
02.09.2016 11:52:56
Micha
Hallo Herbert,
vielen Dank!!!
Ich bin erst heute Nachmittag wieder an meienm PC.
Werde das gerne testen und natürlich hier ein Feedback posten.
1.000 DANK für Deine Hilfe.
Micha
AW: Bitte um kleine VBA Hilfe
02.09.2016 11:55:33
Herbert
Hallo Micha,
ok, aber gib mir bitte kurz bescheid, ob Du es brauchen kannst.
Servus
AW: Bitte um kleine VBA Hilfe
02.09.2016 13:54:11
Micha
Hallo Herbert,
der zweite Code funktioniert soweit Prima.
Gibt es noch die Möglichkeit das die Zelle mit den eingefügten Inhalten nach der Ausführung markiert wird, so das bei mehrmaligen ausführen des Makros immer die nächste Zeile gefüllt wird. Die Zeilen mit "x" sollen natürlich weiterhin übersprungen werden?
Vielen lieben Dank,
Micha
Anzeige
AW: Bitte um kleine VBA Hilfe
04.09.2016 09:47:19
fcs
Hallo Micha,
sollt so funktionieren. 
Sub testcopy()
Dim iCount As Long
Do
iCount = iCount + 1
Loop While ActiveCell.Offset(iCount, -ActiveCell.Column + 1).Value = "x"
With ActiveCell.Offset(iCount, 0)
.Value = ActiveCell.Value
.Select
End With
End Sub

Gruß
Franz
Anzeige
AW: Bitte um kleine VBA Hilfe
05.09.2016 08:40:35
Micha
Hallo Franz und alle anderen Helfer
Das funktioniert super, vielen Dank.
Ich habe noch einen Wunsch für den perfekten Start in die Woche :-)
Ist es auch möglich nicht die aktivierte Zelle zu kopieren, sondern die drei Zellen rechts neben der aktivierten Zelle?
Wenn das auch noch klappt bin ich echt glücklich!!!
Besten Gruß, Micha
Anzeige
AW: Bitte um kleine VBA Hilfe
05.09.2016 12:53:34
fcs
Hallo Micha,
mit entsprechenden Offset-Anweisungen kannst du festlegen, was wohin übertragen werden soll relativ zu anderen Zellen. 
Sub testcopy()
Dim iCount As Long
Do
iCount = iCount + 1
Loop While ActiveCell.Offset(iCount, -ActiveCell.Column + 1).Value = "x"
With ActiveCell.Offset(iCount, 0)
.Offset(0, 3).Value = ActiveCell.Offset(0, 3).Value
.Select
End With
End Sub
Gruß
Franz
Anzeige
AW: Bitte um kleine VBA Hilfe
05.09.2016 15:35:39
Micha
DANKE FRANZ!!!
Das war die Lösung.
Toll das Du Dir die Mühe gemacht hast mir zu helfen.
Den Bereich habe ich dann so angepasst, und funktioniert prima: 
.Offset(0, 1).Range("A1:H1").Value = ActiveCell.Offset(0, 1).Range("A1:H1").Value
Nochmals 1.000 Dank
Micha
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige