2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
Legfrissebb anyagok
PROHARDVER! témák
Mobilarena témák
IT café témák
GAMEPOD témák
  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    LOGOUT

    A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
    Kérdés felvetése előtt olvasd el, ha még nem tetted.

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

  • #29902 huliganboy addikt huliganboy #29900
    Új Válasz #29902
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    huliganboy

    addikt

    válasz huliganboy #29900 üzenetére

    Végül ez lett a megoldás...

    Sub ttt()
    mappak = Array ' Nálad persze más és más
    ' lehet egy dir("e:",vbdirectory) a feltöltésben, ha egy mappán belül vannak.

    For Each mappa In mappak
    Set uj = Workbooks.Add
    fajl = Dir(mappa & "*.xls")
    celsor = 1
    Do While fajl <> ""
    Workbooks.Open Filename:=mappa & fajl, ReadOnly:=True
    sor = Range("a1").SpecialCells(xlLastCell).Row
    If celsor = 1 Then
    Range("a1", Range("a1").SpecialCells(xlLastCell)).Copy uj.Sheets(1).Cells(celsor, 1)
    celsor = celsor + sor
    Else
    Range("a2", Range("a1").SpecialCells(xlLastCell)).Copy uj.Sheets(1).Cells(celsor, 1)
    celsor = celsor + sor - 1
    End If
    ActiveWorkbook.Close False
    fajl = Dir()
    Loop
    uj.SaveAs mappa & "eredmeny.xls"
    'uj.Close False
    Next
    MsgBox "Kész"
    End Sub

    Viszont még ebbe bele kellene aplikálni, hogy a C oszlopban azonos sorokat törölje illetve a megadott oszlopokat is törölje!!

    [ Módosította: CoolMan ]

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