AW: Spalten durchlaufen, nach Bedingung kopieren
21.01.2014 16:27:55
fcs
Hallo Nershi,
ich habe ein kleines VBA problem und hier bisher keine Lösung gefunden.
Für spezielle Probleme wirst du nie eine 100% passende Lösung finden, halt nur prinzipielle Vorgehensweisen.
Nachfolgend ein Makro,das du noch ein wenig an deine Tabelle anpassen musst.
Gruß
Franz
Sub CopyWas()
Dim wks As Worksheet
Dim Zeile As Long, Spalte As Long
Dim Zeile_L As Long, Spalte_L As Long
Dim Zeile_Ziel As Long, rngCopy As Range
Set wks = ActiveSheet
'Set wks = ActiveWorkbook.Worksheets("Tabelle2")
With wks
'Letzte Zeile mit Daten in Spalte A
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
Zeile_Ziel = Zeile_L + 1 '1. einfügezeile für Kopien ggf. anpassen!!
For Zeile = 4 To Zeile_L 'startzeile anpassen !!!
'letzte Spalte mit Wert in Zeile
Spalte_L = .Cells(Zeile, .Columns.Count).End(xlToLeft).Column
Set rngCopy = Nothing
For Spalte = 1 To Spalte_L
If .Cells(Zeile, Spalte) > 0 Then
Set rngCopy = .Range(.Cells(Zeile, Spalte), .Cells(Zeile, Spalte_L))
rngCopy.Copy
.Cells(Zeile_Ziel, 1).PasteSpecial Paste:=xlPasteValues
Zeile_Ziel = Zeile_Ziel + 1
Exit For
End If
Next
Next Zeile
Application.CutCopyMode = False
End With
End Sub