Keresés

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

  • Mutt

    senior tag

    válasz wednesday #39417 üzenetére

    Szia,

    Itt van mutatott mintához a makró. A kommentek alapján tudod finomítani.

    Sub Mentes()
    Const urlap_helye = "Urlap" 'munkalap neve ahol van az űrlap
    Const mentes_helye = "Mentes" 'munkalap neve ahova menteni kellene

    Dim utolsoSor As Long, i As Long
    Dim wsForras As Worksheet
    Dim wsMentes As Worksheet

    Set wsForras = ThisWorkbook.Sheets(urlap_helye)
    Set wsMentes = ThisWorkbook.Sheets(mentes_helye)

    With wsMentes
    utolsoSor = .Range("A" & Rows.Count).End(xlUp).Row + 1 'megkeressük az első szabadsort a mentés lapon

    For i = 17 To 35 'az űrlap 17-35 sora között nézzük a felírásokat
    If Len(.Cells(i, "C")) > 0 Then
    .Cells(utolsoSor, "A") = Now 'A-oszlopba rögzíjük a mentés dátumát
    .Cells(utolsoSor, "B") = wsForras.Range("D7") 'B-oszlopba jön az első sorban lévő D-L egyesített cella tartalma
    .Cells(utolsoSor, "C") = wsForras.Range("B" & i) 'C-oszlopba jön a B-oszlopbeli sorszám
    .Cells(utolsoSor, "D") = wsForras.Range("C" & i) 'D-oszlopba a C-H tartalma
    .Cells(utolsoSor, "E") = wsForras.Range("J" & i) 'E-oszlopba a J tartalma
    .Cells(utolsoSor, "F") = wsForras.Range("K" & i) 'F-oszlopba a K tartalma

    If .Cells(i, "C").MergeCells Then 'ha összevont cellákról van szó, akkor át kell ugornunk az összevont sorokat
    i = i + .Cells(i, "C").MergeArea.Rows.Count - 1
    End If
    utolsoSor = utolsoSor + 1
    End If
    Next i

    End With

    Set wsForras = Nothing
    Set wsMentes = Nothing

    End Sub

    üdv

  • lappy

    őstag

    válasz wednesday #39417 üzenetére

    Miért nem csinálod úgy hogy a táblázat olyan amilyenre szeretnéd csak ahova mented az automatizalva van. Lenne fenn egy gomb ha ezt megnyomod menti a másik füzetbe a dátumot adatokat egymás után. Majd ha átkerült törli az adatokat. Egy makroval megoldható

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

Hirdetés