AW: Spalteninhalte ab D in Spalte A kopieren
14.10.2006 13:25:08
fcs
Hallo Wolfgang,
diese Variante kopiert die Inhalte der ausgefüllten Zellen in die Spalte A
Gruss
Franz
Sub Kopieren()
'Überträgt Werte aus Zellbereich D2:Mxxx innerhalb aller Blätter in Spalte A
Dim wks As Worksheet, ZeileS As Long, SpalteE As Integer, SpalteL As Integer
Dim SpalteZ As Integer, ZeileZ1 As Long, ZeileZ As Long, ZeileL As Long, ZeileLmax
Dim Zeile As Long, Spalte As Integer
ZeileS = 2 ' 1. Zeile für Kopieren von Werten aus Spalte D bis M
SpalteE = 4 ' 1. Spalte die kopiert werden soll, hier D
SpalteL = 13 ' letzte Spalte die kopiert werden soll, hier M
SpalteZ = 1 ' Zielspalte, hier Spalte A
ZeileZ1 = 2 '1. Zeile in Zielspalte in die Werte kopiert werden sollen
For Each wks In ActiveWorkbook.Worksheets
With wks
If Not (.Name = "Start" Or wks.Name = "Daten") Then
'vorhandene Daten in Zielspalte (Spalte A) löschen
.Range(.Cells(ZeileZ1, SpalteZ), .Cells(.Rows.Count, SpalteZ)).ClearContents
'Daten kopieren
For Spalte = SpalteE To SpalteL
ZeileL = .Cells(.Rows.Count, Spalte).End(xlUp).Row
If ZeileL > ZeileLmax Then ZeileLmax = ZeileL
For Zeile = ZeileS To ZeileL
If Not IsEmpty(.Cells(Zeile, Spalte)) Then
' .Cells(ZeileZ, SpalteZ).Value = .Cells(Zeile, Spalte).Value 'Nur Werte übertragen
.Cells(Zeile, Spalte).Copy Destination:=.Cells(ZeileZ, SpalteZ) 'Zellen kopieren
ZeileZ = ZeileZ + 1
End If
Next Zeile
Next Spalte
End If
'Daten im Bereich der Spalten D bis M entfernen (deaktiviert)
'.Range(.Cells(ZeileS, SpalteE), .Cells(ZeileLmax, SpalteL)).ClearContents
End With
ZeileLmax = 0
ZeileZ = ZeileZ1
Next wks
End Sub