AW: Daten aus Tabellenblatt1 je nach Bezug in andere T
02.02.2019 08:24:45
Sepp
Hallo Stefan,
in das Modul des Hauptblattes. (Rechtsklick auf das Blattregister > Code anzeigen > in das rechte Fenster einfügen)
Die Daten werden beim Eintragne des Kundennamens übertragen.
Microsoft Excel Objekt Tabelle1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objWS As Worksheet, strName As String
With Target
If .Column = 4 And .Row > 1 And .Count = 1 Then
If Len(.Value) Then
strName = ValidSheetName(.Value)
If SheetExist(strName) Then
Set objWS = Sheets(strName)
Else
Set objWS = Worksheets.Add(After:=Sheets(Sheets.Count))
With objWS
.Name = strName
.Range("A1:C1") = Array("Datum", "Text", "Betrag")
.Range("A1:C1").Font.Bold = True
End With
End If
With objWS
.Rows(2).Insert
Target.Offset(0, -3).Resize(1, 3).Copy .Cells(2, 1)
End With
End If
Me.Activate
End If
End With
End Sub
Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook, Optional ByVal byCodeName As Boolean = False) As Boolean
Dim wks As Object
On Error GoTo ERRORHANDLER
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Sheets
If byCodeName Then
If LCase(wks.CodeName) = LCase(sheetName) Then SheetExist = True: Exit Function
Else
If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
End If
Next
ERRORHANDLER:
SheetExist = False
End Function
Private Function ValidSheetName(ByVal strName As String) As String
'Returns a valid name for excel-sheets
Dim objRegExp As Object, strTmp As String
On Error GoTo ErrExit
Set objRegExp = CreateObject("vbscript.regexp")
With objRegExp
.Global = True
.Pattern = "[\/\\:\*\?\[\]]"
.IgnoreCase = True
strTmp = Trim$(.Replace(strName, ""))
.Pattern = "[ ]+"
strTmp = .Replace(strTmp, " ")
End With
If Len(strTmp) Then
ValidSheetName = Left(strTmp, 31)
Else
GoTo ErrExit
End If
Exit Function
ErrExit:
ValidSheetName = "Invalid Name!"
End Function
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0