AW: wenn Wert in Zeile dann Spalte kopieren
26.08.2011 19:40:08
fcs
Hallo Valeri,
das nachfolgende Makro sollte es tun. Das Makro kopiert die Formate und Werte der zutreffenden Spalten jeweils in ein neues Tabellenblatt.
Gruß
Franz
Sub CopySpalten()
Dim wksQ As Worksheet, wksZ As Worksheet
Dim SpalteQ As Long, SpalteZ As Long, vAuswahl
Set wksQ = ActiveSheet
vAuswahl = Application.InputBox(Prompt:="Welche Zeile soll ausgewertet werden? 1 oder 2", _
Title:="Spalten mit Wert in Zeile 1 oder 2 > 0 kopieren", Default:=1, Type:=1)
Select Case vAuswahl
Case 0 'Abbrechen wurde gewählt
Case 1, 2
With wksQ
SpalteZ = 0
For SpalteQ = 3 To .Cells(vAuswahl, .Columns.Count).End(xlToLeft).Column
If .Cells(vAuswahl, SpalteQ) > 0 Then
If wksZ Is Nothing Then
Worksheets.Add
Set wksZ = ActiveSheet
End If
.Columns(SpalteQ).Copy
SpalteZ = SpalteZ + 1
wksZ.Cells(1, SpalteZ).PasteSpecial Paste:=xlPasteFormats
wksZ.Cells(1, SpalteZ).PasteSpecial Paste:=xlPasteValues
End If
Next
End With
Application.CutCopyMode = False
If wksZ Is Nothing Then
MsgBox "Keine zutreffenden Spalten zum Kopieren gefunden"
Else
Range("A4").Select
ActiveWindow.FreezePanes = True
End If
Case Else
MsgBox """" & vAuswahl & """ ist ein unzulässsiger Wert", vbInformation, _
"Spalten mit Wert in Zeile 1 oder 2 > 0 kopieren"
End Select
End Sub