Codenamen in Variabeln

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Dim intNummer As Integer Dim WS1 As Worksheet, WS2 As Worksheet intNummer = 1 'Beispiel Set WS1 = Worksheets("tbl_" & Format(intNummer, "00") & "_11_EI") Set WS2 = Worksheets("tbl_" & Format(intNummer, "00") & "_16_AB") WS2.Range("B3:B18") = WS1.Range("B32:B47").Value End Sub

Sub AAVar1() Dim ws As Worksheet ' Eingabe des Codenamens in einem Wort --> funktioniert Set ws = tbl_00_16_AB ws.Name = "Januar" Range("B5").Value = "XX" ws.Range("C5").Value = "Hugo" End Sub

Sub AAVar2() Dim ws As Worksheet Dim intNummer As Integer intNummer = 0 ' Eingabe des Codenamens Zusammengesetzt --> funktioniert nicht Set ws = Worksheets("tbl_" & Format(intNummer, "00") & "_16_AB") ' Fehler beim Set ws.Name = "Februar" Range("B6").Value = "YY" ws.Range("C6").Value = "Fritz" End Sub

Sub t() Dim wksIndex As Worksheet, wksMeins As Worksheet Dim intNummer As Integer Dim strInternerName As String intNummer = 1 strInternerName = "tbl_" & Format(intNummer, "00") & "_16_AB" For Each wksIndex In ThisWorkbook.Worksheets If wksIndex.CodeName = strInternerName Then Set wksMeins = wksIndex Exit For End If Next wksIndex MsgBox wksMeins.Name End Sub

Hallo Norbert,

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

Option Explicit

Sub test()
Dim objSht1 As Worksheet, objSht2 As Worksheet
Dim lngIndex As Long

lngIndex = 0

Set objSht1 = getSheetByCodename("tbl_" & Format(lngIndex, "00") & "_11_EI")
Set objSht2 = getSheetByCodename("tbl_" & Format(lngIndex, "00") & "_16_AB")

If Not objSht1 Is Nothing And Not objSht2 Is Nothing Then
  objSht2.Range("B3:B18") = objSht1.Range("B32:B47").Value
End If

Set objSht1 = Nothing
Set objSht2 = Nothing
End Sub

Private Function getSheetByCodename(ByVal strCodeName As String, Optional ByRef objWorkBook As Workbook) As Object
Dim objSheet As Object
On Error GoTo ERRORHANDLER
If objWorkBook Is Nothing Then Set objWorkBook = ThisWorkbook
For Each objSheet In objWorkBook.Sheets
  If objSheet.CodeName = strCodeName Then
    Set getSheetByCodename = objSheet
    Set objSheet = Nothing
    Exit Function
  End If
Next
ERRORHANDLER:
Set getSheetByCodename = Nothing
End Function

Gruß Sepp

If Not objSht1 Is Nothing And Not objSht2 Is Nothing Then objSht1.Range("B32:B47").Copy objSht2.Range("B3:B18").PasteSpecial xlPasteValues objSht2.Range("B3:B18").PasteSpecial xlPasteFormats Application.CutCopyMode = False End If

Hallo Sepp,
die Anweisungen funktionieren alle. Ich habe das Makro im Zieltabellenblatt aufgerufen. Hat nahezu keine Laufzeit.
Danach habe ich die Anweisungen in mein Worksheet_Change(ByVal Target As Excel.Range) der Ausgangstabelle eingebaut. Trotz Application.ScreenUpdating = False und Application.Calculation = xlCalculationManual flackert der Cursor. Für die Abarbeitung der Schleifen werden 6 x 16 Zeilen durchlaufen. Bis zu der Position vor den Schleifen läuft der Code sehr schnell ohne flackern. Ich habe vor den Schleifen ein Activate der Zieltabelle eingebaut. Dies hat aber auch nichts gebracht. Kann es an der Art des Zugriffs über den Codenamen in den Variablen liegen? Für den Zugriff ist mir noch die Variante über den Blattindex eingefallen. Das Zielblatt liegt fünf Blätter weiter. Erschien mir aber nicht so sicher. Außerdem würde ich recht ungern alles nochmal umprogrammieren. Fällt dir hierzu noch etwas als Hilfe ein.
Im Voraus schon einmal besten Dank auch für die vorangegangene Hilfestellung. Grüße Norbert

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread