Excel vba Richtiges umkopieren

[sharky51]

Hallo zusammen,

darf ich Euch wieder mal um Eure Hilfe bitten?
Ich habe folgende Tabelle in der ich in der Spalte V Spieler per "x" auswähle. Dann soll auf die "x" gefiltert werden und das Filterergebnis, also die sichtbaren "x" in die Spalte "Z" übertragen werden
Damit steht in der Spalte "Z" die erste Auswahl. Wird nun in Spalte "V" eine neue Auswahl getroffen soll nach der Filterung dieses Ergebnis wieder übertragen werden..aber in die nächste frei Spalte...hier nun in die Spalte "AA".

Wie kann man so ezwas per VBA umsetzen? Das umkopieren könnte gleich nach der Filterung automatisch umkopiert werden.


Aufstellungsvarianten

	U	V	W	X	Y	Z	AA	AB	AC	AD
26		Auswahl				R1	R2	R3	R4	R5
27	Spieler 1	x
28	Spieler 2
29	Spieler 3	x
30	Spieler 4
31	Spieler 5
32	Spieler 6	x
33	Spieler 7
34	Spieler 8	x
35	Spieler 9
36	Spieler 10	x

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 21.08 einschl. 64 Bit

Wäre schön wenn mir jemand einen Tipp geben könnte.
Vielen Dank!

[Ego]

Hallo Erich,

ich habe die Anfrage noch nicht ganz verstanden. 

a) Wenn ich die Eingabe in Spalte V mache und nach Spalte Z übertrage wofür benötige ich dann einen Filter und warum mache ich die Eingaben nicht direkt in Spalte Z?

b) Wenn das Kopieren nicht in der gleichen Zeile erfolgen soll, sondern fortlaufend ab Zeile 2, wofür das Filtern und was mach ich dann mit einer Liste voller x?

[atilla]

Hallo Erich,

ich habe hier etwas zusammengebastelt ohne den Filter zu nutzen:

Code:

Sub übertragen()
Dim i As Long, k As Long
Dim lngS As Long
Dim lngZ As Long
Dim lngA As Long
Dim feld
Dim arr()

lngS = Application.Max(26, Cells(27, Columns.Count).End(xlToLeft).Column)
lngZ = Application.Max(27, Cells(Rows.Count, "U").End(xlUp).Row)
lngA = Application.CountIf(Range(Cells(27, "U"), Cells(lngZ, 3)), "x")
feld = Range(Cells(27, 2), Cells(lngZ, 3))

If lngA > 0 Then
 ReDim arr(lngA - 1)
 For i = 1 To lngZ - 28
   If feld(i, 2) = "x" Then
     arr(k) = feld(i, 1)
     k = k + 1
   End If
 Next i
 
 If k > 0 Then
   Cells(27, lngS + 1).Resize(k) = Application.Transpose(arr)
 End If
 
End If
   
End Sub

[sharky51]

Hallo Erich,

ich habe die Anfrage noch nicht ganz verstanden. 

a) Wenn ich die Eingabe in Spalte V mache und nach Spalte Z übertrage wofür benötige ich dann einen Filter und warum mache ich die Eingaben nicht direkt in Spalte Z?

b) Wenn das Kopieren nicht in der gleichen Zeile erfolgen soll, sondern fortlaufend ab Zeile 2, wofür das Filtern und  was mach ich dann mit einer Liste voller x?

Hallo Helmut,
zu a) nun den Filter benötige ich nicht unbedingt, der Filter sollte nur der Auslöser für das Umkopieren sein. Und wenn einmal Einträgr in Spalte Z stehen sollen diese nicht mehr überschrieben werden sondern nach den erneuten und geänderten Einträgen in Spalte V die Spalte AA beschrieben werden.

zu b) die Liste voller x soll eine gewisse Historie darstellen welcher Spieler zu einem bestimmten Event (Spalte Z bis Spalte AD) ausgewählt war.

Der Filter war nur die Idee die Geschichte übersichtlicher zu gestalten.

Ich hoffe das ist jetzt nicht zu verwirrend beschrieben.

[sharky51]

Hallo Erich,

ich habe hier etwas zusammengebastelt ohne den Filter zu nutzen:

Code:

Sub übertragen()
Dim i As Long, k As Long
Dim lngS As Long
Dim lngZ As Long
Dim lngA As Long
Dim feld
Dim arr()

lngS = Application.Max(26, Cells(27, Columns.Count).End(xlToLeft).Column)
lngZ = Application.Max(27, Cells(Rows.Count, "U").End(xlUp).Row)
lngA = Application.CountIf(Range(Cells(27, "U"), Cells(lngZ, 3)), "x")
feld = Range(Cells(27, 2), Cells(lngZ, 3))

If lngA > 0 Then
 ReDim arr(lngA - 1)
 For i = 1 To lngZ - 28
   If feld(i, 2) = "x" Then
     arr(k) = feld(i, 1)
     k = k + 1
   End If
 Next i
 
 If k > 0 Then
   Cells(27, lngS + 1).Resize(k) = Application.Transpose(arr)
 End If
 
End If
   
End Sub

Hallo Attila,

leider kann ich nicht erkennen wie das funktionieren soll.

Trotzdem vielen Dank!

[atilla]

Hallo Erich,

Du fügst den Code am besten in das Codefenster der Tabelle.
Danach kannst Du ihn dann mal anschubsen und schauen was er in einer Kopie Deiner Datei veranstaltet.

[sharky51]

Hallo Erich,

Du fügst den Code am besten in das Codefenster der Tabelle.
Danach kannst Du ihn dann mal anschubsen und schauen was er in einer Kopie Deiner Datei veranstaltet.

Hallo Attila,

hab ich gemacht ...aber schon ab hier
If lngA > 0 Then...springt das Programm direkt raus aus der Sub. Es passiert nichts.

[Ego]

Hallo Erich,

die Frage warum du die Auswahl nicht direkt in der "richtigen" Spalte (Z;AA;...) machst hast du noch nicht beantwortet.

[atilla]

Hallo Erich,

das war blöd von mir.
Ich hatte den Code mit anderen Zellbzügen entwickelt und habe ihn nachträglich falsch auf Dein eingestelltes Beispiel angepasst.

Folgender Code sollte funktionieren:

Code:

Sub übertragen()
Dim i As Long, k As Long
Dim lngS As Long
Dim lngZ As Long
Dim lngA As Long
Dim feld
Dim arr()

lngS = Application.Max(25, Cells(27, Columns.Count).End(xlToLeft).Column)
lngZ = Application.Max(27, Cells(Rows.Count, "U").End(xlUp).Row)
lngA = Application.CountIf(Range(Cells(27, "U"), Cells(lngZ, "V")), "x")
feld = Range(Cells(27, "U"), Cells(lngZ, "V"))

If lngA > 0 Then
ReDim arr(lngA - 1)
For i = 1 To lngZ - 28
  If feld(i, 2) = "x" Then
    arr(k) = feld(i, 1)
    k = k + 1
  End If
Next i

If k > 0 Then
  Cells(27, lngS + 1).Resize(k) = Application.Transpose(arr)
End If

End If
 
End Sub

[sharky51]

Hallo Erich,

die Frage warum du die Auswahl nicht direkt in der "richtigen" Spalte (Z;AA;...)  machst hast du noch nicht beantwortet.

Hallo Helmut,
weil ich die Auswahl eigentlich nur an einer Stelle machen möchte und diese dann übertragen möchte.