Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Übernahme von Tabelle 1 auf Tabelle 2

Betrifft: Übernahme von Tabelle 1 auf Tabelle 2 von: Clark
Geschrieben am: 09.09.2020 13:42:11

Guten Tag liebe Mitglieder

Ich habe folgendes Problem
Ich habe ein Makro wo in der Tabelle1 mehrere Datume eingetragen werden.

Jetzt möchte ich das in Tabelle2 die gleichen Einträge übernommen werden
Wie muss ich den folgenden Code umändern damit diese auch in Tabelle2 übernommen werden?

Private Sub cmd_ok_Click()
    Dim wkSh As Worksheet, rng As Range, _
        mycheck As Integer, i As Integer

    Set wkSh = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
        Set rng = wkSh.Range("C19:C32")
    Range("C19:C32").ClearContents
    For i = 0 To Me.lst_day.ListCount - 1
        If Me.lst_day.Selected(i) = True Then
            mycheck = mycheck + 1
            rng(mycheck, 1).Value = CDate(Left(Me.lst_day.List(i), 8))
            
        End If
    Next
    If mycheck = 0 Then
        MsgBox "bitte Tage wählen"
    End If
End Sub


Betrifft: AW: sehe weder Tabelle1 noch Tabelle2
von: JoWE
Geschrieben am: 09.09.2020 13:52:43



Betrifft: AW: sehe weder Tabelle1 noch Tabelle2
von: Clark
Geschrieben am: 09.09.2020 15:34:38

Hallo JoWe
Das ist nur ein Teil des Codes.
Bin davon ausgegangen das dieser reichen würde weil ich dachte das ich nur diesen Code bzw. diese Zeile bearbeiten muss...
Set wkSh = ThisWorkbook.Worksheets("Tabelle1")

Hier ist der ganze Code...

Option Explicit
Private Sub cbo_year_Change()
Me.lst_day.Clear
Call my_days
End Sub

Private Sub chk_0_Click()
Me.lst_day.Clear
Call my_days
End Sub

Private Sub chk_1_Click()
Me.lst_day.Clear
Call my_days
End Sub

Private Sub chk_2_Click()
Me.lst_day.Clear
Call my_days
End Sub

Private Sub chk_3_Click()
Me.lst_day.Clear
Call my_days
End Sub

Private Sub chk_4_Click()
Me.lst_day.Clear
Call my_days
End Sub

Private Sub chk_5_Click()
Me.lst_day.Clear
Call my_days
End Sub

Private Sub chk_6_Click()
Me.lst_day.Clear
Call my_days
End Sub

Private Sub chk_all_Click()
Dim i As Integer
If Me.chk_all Then
    For i = 0 To Me.lst_day.ListCount - 1
        Me.lst_day.Selected(i) = True
    Next
Else
    For i = 0 To Me.lst_day.ListCount - 1
        Me.lst_day.Selected(i) = False
    Next
End If
End Sub

Private Sub chk_month_Click()
If Me.chk_month Then
    Me.lst_month.MultiSelect = fmMultiSelectMulti
    Me.cmd_akt.Enabled = True
Else
    Me.lst_month.MultiSelect = fmMultiSelectSingle
    Me.cmd_akt.Enabled = False
End If
End Sub

Private Sub cmd_abr_Click()
Unload Me
End Sub

Private Sub cmd_akt_Click()
Dim i As Integer
Me.lst_day.Clear
Call my_days

End Sub
Private Sub cmd_ok_Click()
    Dim wkSh As Worksheet, rng As Range, _
        mycheck As Integer, i As Integer

    Set wkSh = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
        Set rng = wkSh.Range("C19:C32")
    Range("C19:C32").ClearContents
    For i = 0 To Me.lst_day.ListCount - 1
        If Me.lst_day.Selected(i) = True Then
            mycheck = mycheck + 1
            rng(mycheck, 1).Value = CDate(Left(Me.lst_day.List(i), 8))
            
        End If
    Next
    If mycheck = 0 Then
        MsgBox "bitte Tage wählen"
    End If
End Sub
Private Sub lst_month_Click()
If Me.lst_month.ListIndex >= 0 Then
    Me.lst_day.Clear
    Call my_days
End If
End Sub

Private Sub UserForm_Activate()
Dim i As Integer

If TypeOf Selection Is Range Then
For i = 1 To 24
    Me.lst_month.AddItem Format(DateSerial(1900, i, 1), "mmmm")
    Me.cbo_year.AddItem Year(Date) - 3 + i
Next
Me.cbo_year.ListIndex = 1
Me.lst_month.ListIndex = Month(Date) - 1
Else
    MsgBox "bitte zuerst Zielzelle wählen"
    Unload Me

End If
End Sub
Sub my_days()
Dim i As Integer, last_day As Long
Dim int_day As Integer, int_Week As Integer, str_F As String, str_chek As String, obj_chkthis As Object
Me.chk_all.Value = False
For i = 0 To Me.lst_month.ListCount - 1
If Me.lst_month.Selected(i) = True Then
str_chek = fCheck
last_day = fday(i)
For int_day = 1 To last_day
For int_Week = 1 To Len(str_chek)
If DateSerial(CInt(Me.cbo_year.Value), i + 1, int_day) Mod 7 = CInt(Mid(str_chek, int_Week, 1)) Then
Set obj_chkthis = Sheets(2).Columns(1).Find(CLng(DateSerial(CInt(Me.cbo_year.Value), i + 1, int_day)), lookat:=xlWhole)
If Not obj_chkthis Is Nothing Then
str_F = " FTag"
Else
str_F = ""
End If
Set obj_chkthis = Nothing
Me.lst_day.AddItem Format(DateSerial(CInt(Me.cbo_year.Value), i + 1, int_day), "dd.mm.yy ddd") & str_F
End If
Next
Next
End If
Next
End Sub Function fday(mymonth As Integer) As Long
fday = Day(DateSerial(CInt(Me.cbo_year.Value), mymonth + 2, 0))
End Function Function fCheck() As String
Dim i As Integer
For i = 0 To 6
If Controls("chk_" & i).Value = True Then
fCheck = fCheck & i
End If
Next
If fCheck = "" Then fCheck = "0123456"
End Function


Betrifft: AW: sehe weder Tabelle1 noch Tabelle2
von: JoWE
Geschrieben am: 09.09.2020 16:08:40

lade doch einfach die Arbeitsmappe hoch.
Zeige darin was Du genau erreichen willst.
Die Codes weisen auf diverse Steuerelenente hin, daher kann nienand ohne die zweifellos vorhandenen Abhängigkeiten damit testen oder programmieren...
Gruß
Jochen

Beiträge aus dem Excel-Forum zum Thema "Übernahme von Tabelle 1 auf Tabelle 2"