Hirdetés

Keresés

Új hozzászólás Aktív témák

  • Declare

    őstag

    válasz Fferi50 #40423 üzenetére

    juhuuuu :D köszi szepen! Müködik.

    Viszont van egy anomalia, amire nem tudok rájönni :(

    Ez a kód:
    (lenyege röviden: a "Tab1" munkafüzet C oszlopaban a "Tab2" munkafüzet nevenek (mindig egy datum, pl 15.03.19) megfelelö datumokat kikeresi. Ha talalal egy egyezöt, akkor kimasolgatja a "Tab1" munkafüzetben a datum soraban talalhato adatokat a "Tab2" munkafüzet megfelelö cellaiba.

    A teszt közben, akarmilyen 2019 es datummal teszteltem, lefut szuperül. 2018 as datumok közül viszont a többseggel nem müködik. Van amivel lefut jol, viszont a legtöbb tesztelt datummal egyszerüen nem fut le, mintha nem lenne a keresett datum a cél munkafüzet C oszlopaban. Pedig ott van es ugyan ugy van formazva. Az egesz C oszlop datumkent van formazva.

    Egy pl: munkafüzet neve 15.03.19 => lefut es szuper.
    10.12.18=> nem fut le (mintha nem talalna, de van)
    09.10.18=> lefut es szuper

    Na erre mondjatok nekem valami magyarazatot es megoldast legyszi, mert total passz a kerdes. Ha viszont a makro hol müködik hol nem, ugy nem sok ertelme volt az egesz eddigi munkamnak vele :( :(

    Sub Aktualisieren_Tagebuch()
    Dim c As Range
    Dim OK As Variant
    Dim iZähler As Integer

    Dim Tab1 As String
    Dim Tab2 As String


    Tab1 = "Bautagebuch"
    Tab2 = ActiveSheet.Name
    OK = Tab2

    Application.ScreenUpdating = False
    iZähler = 15
    With Worksheets(Tab1).Range("C1:C500")

    Set c = .Find(DateValue(OK), LookIn:=xlValues)

    If Not c Is Nothing Then
    firstAddress = c.Address
    Do
    Sheets(Tab1).Select
    Range("B" + Trim(Str$(c.Row))).Select
    Selection.Copy
    Sheets(Tab2).Select
    Range("A" + Trim(Str$(iZähler))).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets(Tab1).Select
    Range("A" + Trim(Str$(c.Row))).Select
    Selection.Copy
    Sheets(Tab2).Select
    Range("B" + Trim(Str$(iZähler))).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets(Tab1).Select
    Range("I" + Trim(Str$(c.Row))).Select
    Selection.Copy
    Sheets(Tab2).Select
    Range("D" + Trim(Str$(iZähler))).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets(Tab1).Select
    Range("E" + Trim(Str$(c.Row))).Select
    Selection.Copy
    Sheets(Tab2).Select
    Range("E" + Trim(Str$(iZähler))).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False



    iZähler = iZähler + 1
    Sheets(Tab1).Select
    Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    End With

    Sheets(Tab2).Select

    Application.ScreenUpdating = True

    End Sub

Új hozzászólás Aktív témák