19.10.2016, 10:38
Hallo Leute,
wer kann mir weiterhelfen?
Ich kopiere eine Spalte und lege ein neues Tabellenblatt nach einem Muster an.
Test_VBA_1_Home.xlsm (Größe: 23,39 KB / Downloads: 0)
Sub Neue_Spalte_anlegen()
Dim Spalte As Long
Dim Zeile As Long
Dim ZeileL As Long
Dim wks As Worksheet
Set wks = ActiveSheet
Zeile = 6 'Zeile mit den Kunden-Nummern
With wks
Spalte = .Cells(Zeile, .Columns.Count).End(xlToLeft).Column
ZeileL = .Cells(.rows.Count, Spalte).End(xlUp).Row
With .Range(.Cells(Zeile, Spalte), .Cells(ZeileL, Spalte))
.Copy .Offset(0, 1)
End With
.Cells(Zeile, Spalte + 1).Value = .Cells(Zeile, Spalte).Value + 1
End With
Worksheets("Muster").Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "Firma " & wks.Cells(Zeile, Spalte).Value + 1
'Hier müsste jetzt eine Funktion stehen, die die Elemente der kopierten Spalte initialisiert (Null oder Blank)
'ohne die Formatierung oder eventuell hinterlegte Formeln zu überschreiben.
Worksheets("Übersicht").Activate
End Sub
Zur Verdeutlichung habe ich die Tabelle in Ihrer Gesamtheit noch angefügt.
Vielen Dank im Voraus.
Michael
wer kann mir weiterhelfen?
Ich kopiere eine Spalte und lege ein neues Tabellenblatt nach einem Muster an.
Test_VBA_1_Home.xlsm (Größe: 23,39 KB / Downloads: 0)
Sub Neue_Spalte_anlegen()
Dim Spalte As Long
Dim Zeile As Long
Dim ZeileL As Long
Dim wks As Worksheet
Set wks = ActiveSheet
Zeile = 6 'Zeile mit den Kunden-Nummern
With wks
Spalte = .Cells(Zeile, .Columns.Count).End(xlToLeft).Column
ZeileL = .Cells(.rows.Count, Spalte).End(xlUp).Row
With .Range(.Cells(Zeile, Spalte), .Cells(ZeileL, Spalte))
.Copy .Offset(0, 1)
End With
.Cells(Zeile, Spalte + 1).Value = .Cells(Zeile, Spalte).Value + 1
End With
Worksheets("Muster").Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "Firma " & wks.Cells(Zeile, Spalte).Value + 1
'Hier müsste jetzt eine Funktion stehen, die die Elemente der kopierten Spalte initialisiert (Null oder Blank)
'ohne die Formatierung oder eventuell hinterlegte Formeln zu überschreiben.
Worksheets("Übersicht").Activate
End Sub
Zur Verdeutlichung habe ich die Tabelle in Ihrer Gesamtheit noch angefügt.
Vielen Dank im Voraus.
Michael