Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Wenn in spalte "x" dann kopiere....
21.03.2014 23:15:58
Matthias
Hallo,
habe folgenden Problem: Ich habe in Spalte A manchmal ein "x" stehen und in den beiden Spalten daneben zwei Werte. Nun sollen alle Werte die ein "x" haben kopiert werden und weiter drunter (quasi sortiert) eingefügt werden. Siehe Beispiel
https://www.herber.de/bbs/user/89790.xlsx
Wer kann helfen?
Vielen Dank und Gruß
Matthias

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

Betreff
Datum
Anwender
Anzeige
AW: Wenn in spalte "x" dann kopiere....
22.03.2014 00:26:39
Matthias
Es soll mit VBA gemacht werden! Keine Sortierung über Sortierungsfunktion vornehmen.

AW: Wenn in spalte "x" dann kopiere....
22.03.2014 18:20:38
Tino
Hallo,
evtl. so.
Nach unten finde ich immer etwas problematisch,
da man nicht den genauen Datenbereich bestimmen kann. (Anfang/Ende)
Eine Variante
Sub Kopiere_Sortiere()
Dim varData, ArNew()
Dim n&, nn&, nCount&, MaxRow&
With Tabelle1
MaxRow = .Cells(1, 2).End(xlDown).Row
varData = .Range("A1", .Cells(MaxRow, 3))
.Range(.Cells(MaxRow + 11, 1), .Cells(.Rows.Count, 3)).Clear
ReDim Preserve ArNew(1 To UBound(varData, 2), 1 To UBound(varData))
For n = 1 To UBound(varData)
If UCase(varData(n, 1)) = "X" Then
nCount = nCount + 1
For nn = 1 To UBound(varData, 2)
ArNew(nn, nCount) = varData(n, nn)
Next nn
End If
Next n
ReDim Preserve ArNew(1 To UBound(ArNew), 1 To nCount)
ArNew = Application.Transpose(ArNew)
With .Range("A1").Offset(MaxRow + 11).Resize(UBound(ArNew), UBound(ArNew, 2))
.Value = ArNew
''vielleicht doch sortieren?  ;-)
'.Sort .Cells(1, 3), xlAscending, Header:=xlNo
End With
End With
End Sub
Gruß Tino

Anzeige
AW: Wenn in spalte "x" dann kopiere....
24.03.2014 10:55:48
Matthias
Hallo Tino,
vielen Dank, funktioniert super! Wäre es auch möglich, dass die Sortierung immer fest in Zeile 20 hinein geschrieben wird und das Zellformatierungen z.B. eine Füllfarbe mit übernommen werden?
Danke & Gruß
Matthias

AW: Wenn in spalte "x" dann kopiere....
24.03.2014 11:24:25
Tino
Hallo,
müsste so funktionieren.
Sub Kopiere_Sortiere()
Dim rngData As Range, rngCol As Range
Dim nCount&, MaxRow&
With Tabelle1
MaxRow = .Cells(1, 2).End(xlDown).Row
If MaxRow > 19 Then
On Error Resume Next
Set rngData = Application.InputBox("Kann Tabellenbereich nicht erkennen!" & vbCr & _
"Bitte Bereich von Hand auswählen", Type:=8)
On Error GoTo 0
Else
Set rngData = .Range("A1", .Cells(MaxRow, 3))
End If
If rngData Is Nothing Then Exit Sub
.Range(.Cells(20, 1), .Cells(.Rows.Count, 3)).Clear
For Each rngData In rngData.Rows
If UCase(rngData.Cells(1, 1).Value) = "X" Then
nCount = nCount + 1
If Not rngCol Is Nothing Then
Set rngCol = Union(rngCol, rngData)
Else
Set rngCol = rngData
End If
End If
Next rngData
If Not rngCol Is Nothing Then
With .Cells(20, 1).Resize(nCount, 3)
rngCol.Copy
.PasteSpecial xlPasteValues 'nur Werte
.PasteSpecial xlPasteFormats 'Format
''vielleicht doch sortieren?  ;-)
'.Sort .Cells(1, 3), xlAscending, Header:=xlNo
Application.CutCopyMode = False
Application.Goto .Cells(1, 1)
End With
End If
End With
End Sub
Gruß Tino

Anzeige
AW: Wenn in spalte "x" dann kopiere....
24.03.2014 13:16:21
Matthias
Hallo Tino,
vielen herzlichen Dank. Das funktioniert prima!!!
Gruß
Matthias

AW: Wenn in spalte "x" dann kopiere....
24.03.2014 18:44:54
Matthias
Hallo,
eine letzt Frage, ich möchte das gern in die Spalten Y,Z, AA verschieben, also das in Spalte Y das "x" steht. Wie muss der Code dann ausschauen?
Danke und Gruß
Matthias

AW: Wenn in spalte "x" dann kopiere....
24.03.2014 22:56:12
Tino
Hallo,
mach aus
.Cells(20,1)
einfach
.Cells(1,25)
Gruß Tino

AW: Wenn in spalte "x" dann kopiere....
25.03.2014 17:53:43
Matthias
Hallo Tino,
da habe ich mich wohl nicht ganz richtig ausgedrückt. Es sind jetzt alle Daten in Splate Y,Z,AA verschoben worden von mir. Es soll quasi das Gleiche passieren nur in den Spalten Y, Z, AA
https://www.herber.de/bbs/user/89840.xlsm
Danke & Gruß
Matthias

Anzeige
AW: Wenn in spalte "x" dann kopiere....
25.03.2014 18:19:41
Matthias
Ich habe es jetzt so abgeändert aber leider funktioniert es nicht wie es soll
Sub Kopiere_Sortiere()
Dim rngData As Range, rngCol As Range
Dim nCount&, MaxRow&
With Tabelle1
MaxRow = .Cells(1, 25).End(xlDown).Row
If MaxRow > 19 Then
On Error Resume Next
Set rngData = Application.InputBox("Kann Tabellenbereich nicht erkennen!" & vbCr & _
"Bitte Bereich von Hand auswählen", Type:=8)
On Error GoTo 0
Else
Set rngData = .Range("Y1", .Cells(MaxRow, 3))
End If
If rngData Is Nothing Then Exit Sub
.Range(.Cells(20, 25), .Cells(.Rows.Count, 3)).Clear
For Each rngData In rngData.Rows
If UCase(rngData.Cells(1, 25).Value) = "X" Then
nCount = nCount + 1
If Not rngCol Is Nothing Then
Set rngCol = Union(rngCol, rngData)
Else
Set rngCol = rngData
End If
End If
Next rngData
If Not rngCol Is Nothing Then
With .Cells(20, 25).Resize(nCount, 3)
rngCol.Copy
.PasteSpecial xlPasteValues 'nur Werte
.PasteSpecial xlPasteFormats 'Format
''vielleicht doch sortieren?  ;-)
'.Sort .Cells(1, 3), xlAscending, Header:=xlNo
Application.CutCopyMode = False
Application.Goto .Cells(1, 25)
End With
End If
End With
End Sub
Gruß
Matthias

Anzeige
AW: Wenn in spalte "x" dann kopiere....
25.03.2014 23:28:07
Tino
Hallo,
die 3 musst du auch anpassen.
.Cells(MaxRow,27)
.Cells(.Rows.Count,27)
Gruß Tino

333 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige