Transportieren
28.02.2009 06:59:53
Ludmila
der Bereich Sheets("Übersicht"). C7:M47 soll nach "Tab9"
transportiert werden.
In Tab9 A1 = Datum aus Übersicht C4
In Tab9 B1 = Uhr aus Übersicht C7
In Tab9 C1 = Name aus Übersicht D7
In Tab9 D1 = Bereich aus Übersicht D6
In Tab9 X1 = Uhr aus Übersicht C8
In Tab9 Y1 = Name aus Übersicht D8
In Tab9 AA1 = Bereich aus Übersicht D6
usw
Sub verteilen()
Dim I As Integer
Dim iRow As Integer
Dim icolumn As Integer
Dim iRow1 As Integer
Dim icolumn1 As Integer
Dim iRow2 As Integer
Dim icolumn2 As Integer
Dim Name As String
Dim Bereich As String
Dim Uhr As Date
Dim Datum As Date
iRow = 7 'Sheets"Übersicht" Name
icolumn = 4 'Sheets"Übersicht" Name
iRow1 = 1 'Sheets"Tab9"
icolumn1 = 3 'Sheets"Tab9"
iRow2 = 6 'Sheets"Übersicht" Bereich
Datum = Sheets("Übersicht").Cells(4, 3).Value
Uhr = Sheets("Übersicht").Cells(7, 3).Value
Uhr = Format(Uhr, "hh:mm")
Sheets("Tab9").Cells(iRow1, icolumn1 - 2) = Datum
Sheets("Tab9").Cells(iRow1, icolumn1 - 1) = Uhr
For I = 1 To 10
Name = Sheets("Übersicht").Cells(iRow, icolumn).Value
Bereich = Sheets("Übersicht").Cells(iRow2, icolumn).Value
Sheets("Tab9").Cells(iRow1, icolumn1) = Name
icolumn1 = icolumn1 + 1
Sheets("Tab9").Cells(iRow1, icolumn1) = Bereich
icolumn1 = icolumn1 + 1
icolumn = icolumn + 1
Next I
iRow = 8 'Sheets"Übersicht" Name
icolumn = 4 'Sheets"Übersicht" Name
iRow1 = 1 'Sheets"Tab9"
icolumn1 = 25 'Sheets"Tab9"
iRow2 = 6 'Sheets"Übersicht" Bereich
Uhr = Sheets("Übersicht").Cells(8, 3).Value
Uhr = Format(Uhr, "hh:mm")
Sheets("Tab9").Cells(iRow1, icolumn1 - 1) = Uhr
For I = 1 To 10
Name = Sheets("Übersicht").Cells(iRow, icolumn).Value
Bereich = Sheets("Übersicht").Cells(iRow2, icolumn).Value
Sheets("Tab9").Cells(iRow1, icolumn1) = Name
icolumn1 = icolumn1 + 1
Sheets("Tab9").Cells(iRow1, icolumn1) = Bereich
icolumn1 = icolumn1 + 1
icolumn = icolumn + 1
Next I
End Sub
Danke für eure Hilfe
Gruß
Ludmila