Zellbezug in neue Zeile

Forumthread: Zellbezug in neue Zeile

14.11.2017 12:48:59

Bündner

Hallo zusammen
Ich komme nicht weiter und hoffe ihr könnt mir helfen.
Folgende Ausgangslage:
In meinem Excel-Sheet möchte ich pro Auftrag eine neues Tabellenblatt generieren. Das habe ich _ hinbekommen - Soweit so gut.


Sub BlattKopieren()
Dim NeuerName As String
Dim i As Integer
NeuerName = InputBox("Wie heisst dein Projekt?")
i = Sheets.Count
Sheets("Neues Projekt").Copy After:=Sheets(i)
ActiveSheet.Name = NeuerName
End Sub

Jetzt möchte ich aber im Tabellenblatt "Übersicht" die wichtigsten Zellen pro Auftragssheet als Zellbezug angezeigt bekommen, um eine Übersicht der Aufträge zu erhalten. Dabei soll bei jedem neuen Auftrag automatisch eine neue Zeile mit den entsprechenden Zellbezügen hergestellt werden.
Ich habe es mit kopieren der Zellen hinbekommen, jedoch möchte ich keine Kopie, sondern einen Bezug herstellen, da sich diese Werte während dem Auftrag noch ändern können.
Ich hoffe ihr könnt mir helfen.
LG, Bündner

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zellbezug in neue Zeile

14.11.2017 15:01:37

Sepp
AW: Zellbezug in neue Zeile

15.11.2017 10:55:19

Bündner

AW: Zellbezug in neue Zeile

14.11.2017 15:01:37

Sepp

Hallo Bündner?,

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub BlattKopieren()
Dim NeuerName As String
Dim i As Integer
NeuerName = InputBox("Wie heisst dein Projekt?")
If Not SheetExist(NeuerName) Then
  If IsValidSheetName(NeuerName) Then
    i = Sheets.Count
    Sheets("Neues Projekt").Copy After:=Sheets(i)
    Sheets(Sheets.Count).Name = NeuerName
    With Sheets("Übersicht")
      .Cells(i + 1, 1) = NeuerName
      .Cells(i + 1, 2).Formula = "='" & NeuerName & "'!B5" 'Zellbezug zur neuen Tabelle!
      .Activate
    End With
  Else
    MsgBox "Der Name '" & NeuerName & "' ist ungültig!"
  End If
Else
  MsgBox "Eine Tabelle mit dem Naen '" & NeuerName & "' ist bereits vorhanden!"
End If

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 IsValidSheetName(ByVal strName As String) As Boolean
'Validates a gifen string
Dim objRegExp As Object

Set objRegExp = CreateObject("vbscript.regexp")

With objRegExp
  .Global = True
  .Pattern = "^[^\/\\:\*\?\[\]]{1,31}$"
  .IgnoreCase = True
  IsValidSheetName = .test(strName)
End With

Set objRegExp = Nothing

End Function

Gruß Sepp

AW: Zellbezug in neue Zeile

15.11.2017 10:55:19

Bündner

Hallo Sepp
Wow, genial! Funktionier einwandfrei!!
Vielen Dank für deine Hilfe und die rasche Rückmeldung.
LG, Bündner

Beliebteste Forumthreads (12 Monate)

Forumthread: Zellbezug in neue Zeile

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread