von bst » Di, 30.11.2010 16:11
Hi,
in VBA sollte das M.E. - besser - so aussehen:
Code: Alles auswählen
Option Explicit
Sub DatenUebernahme()
Dim Z As Long
Select Case Worksheets(1).Range("B7").Value
Case "Schule"
With Worksheets(2)
Z = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Z, 1).Value = Range("b5").Value
.Cells(Z, 2).Value = Range("b6").Value
.Cells(Z, 3).Value = Range("b8").Value
.Cells(Z, 4).Value = Range("b9").Value
End With
Case "Sporthalle"
With Worksheets(6)
Z = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Z, 1).Value = Range("b5").Value
.Cells(Z, 2).Value = Range("b6").Value
.Cells(Z, 3).Value = Range("b10").Value
.Cells(Z, 4).Value = Range("b11").Value
.Cells(Z, 5).Value = Range("b12").Value
.Cells(Z, 7).Value = Range("b13").Value
End With
End Select
End Sub
In OO Basic kannst Du das mal so versuchen.
Code: Alles auswählen
Option Explicit
Sub DatenUebernahme()
Dim Z As Long
Dim oSrcSheet As Object, oDstSheet As Object
oSrcSheet = ThisComponent.Sheets(0)
Select Case oSrcSheet.getCellRangeByName("b7").String
case "Schule"
oDstSheet = ThisComponent.sheets(1)
Z = getLastRowInColumn(oDstSheet, 0) + 1
prcCopyValue oSrcSheet.getCellRangeByName("b5"), oDstSheet.getCellByPosition(0,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b6"), oDstSheet.getCellByPosition(1,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b8"), oDstSheet.getCellByPosition(2,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b9"), oDstSheet.getCellByPosition(3,Z)
Case "Sporthalle"
oDstSheet = ThisComponent.sheets(5)
Z = getLastRowInColumn(oDstSheet, 0) + 1
prcCopyValue oSrcSheet.getCellRangeByName("b5"), oDstSheet.getCellByPosition(0,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b6"), oDstSheet.getCellByPosition(1,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b10"), oDstSheet.getCellByPosition(2,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b11"), oDstSheet.getCellByPosition(3,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b12"), oDstSheet.getCellByPosition(4,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b13"), oDstSheet.getCellByPosition(6,Z)
End Select
End Sub
Function getLastRowInColumn(oSheet as Object, iColumn as integer) as Long
dim oUsedCells as Object
oUsedCells = oSheet.Columns(iColumn).queryContentCells(23)
if oUsedCells.Count = 0 Then
getLastRowInColumn = -1
else
getLastRowInColumn = oUsedCells.RangeAddresses(oUsedCells.Count-1).endRow
endif
End Function
Sub prcCopyValue(oSrcRange as Object, oDstRange as Object)
dim arData as Variant
arData = oSrcRange.getDataArray()
oDstRange.setDataArray(arData)
End Sub
Hi,
in VBA sollte das M.E. - besser - so aussehen:
[code]Option Explicit
Sub DatenUebernahme()
Dim Z As Long
Select Case Worksheets(1).Range("B7").Value
Case "Schule"
With Worksheets(2)
Z = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Z, 1).Value = Range("b5").Value
.Cells(Z, 2).Value = Range("b6").Value
.Cells(Z, 3).Value = Range("b8").Value
.Cells(Z, 4).Value = Range("b9").Value
End With
Case "Sporthalle"
With Worksheets(6)
Z = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Z, 1).Value = Range("b5").Value
.Cells(Z, 2).Value = Range("b6").Value
.Cells(Z, 3).Value = Range("b10").Value
.Cells(Z, 4).Value = Range("b11").Value
.Cells(Z, 5).Value = Range("b12").Value
.Cells(Z, 7).Value = Range("b13").Value
End With
End Select
End Sub
[/code]
In OO Basic kannst Du das mal so versuchen.
[code]Option Explicit
Sub DatenUebernahme()
Dim Z As Long
Dim oSrcSheet As Object, oDstSheet As Object
oSrcSheet = ThisComponent.Sheets(0)
Select Case oSrcSheet.getCellRangeByName("b7").String
case "Schule"
oDstSheet = ThisComponent.sheets(1)
Z = getLastRowInColumn(oDstSheet, 0) + 1
prcCopyValue oSrcSheet.getCellRangeByName("b5"), oDstSheet.getCellByPosition(0,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b6"), oDstSheet.getCellByPosition(1,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b8"), oDstSheet.getCellByPosition(2,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b9"), oDstSheet.getCellByPosition(3,Z)
Case "Sporthalle"
oDstSheet = ThisComponent.sheets(5)
Z = getLastRowInColumn(oDstSheet, 0) + 1
prcCopyValue oSrcSheet.getCellRangeByName("b5"), oDstSheet.getCellByPosition(0,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b6"), oDstSheet.getCellByPosition(1,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b10"), oDstSheet.getCellByPosition(2,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b11"), oDstSheet.getCellByPosition(3,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b12"), oDstSheet.getCellByPosition(4,Z)
prcCopyValue oSrcSheet.getCellRangeByName("b13"), oDstSheet.getCellByPosition(6,Z)
End Select
End Sub
Function getLastRowInColumn(oSheet as Object, iColumn as integer) as Long
dim oUsedCells as Object
oUsedCells = oSheet.Columns(iColumn).queryContentCells(23)
if oUsedCells.Count = 0 Then
getLastRowInColumn = -1
else
getLastRowInColumn = oUsedCells.RangeAddresses(oUsedCells.Count-1).endRow
endif
End Function
Sub prcCopyValue(oSrcRange as Object, oDstRange as Object)
dim arData as Variant
arData = oSrcRange.getDataArray()
oDstRange.setDataArray(arData)
End Sub
[/code]