2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
  • 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

  • #27002 Cifu félisten Árnymester #26982
    Új Válasz #27002
    Ú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

    Cifu

    félisten

    LOGOUT blog

    válasz Árnymester #26982 üzenetére

    Próbálkozom, de sehogy sem sikerül.... :U

    A probléma (ha jól látom) a következő:

    A nekem nem külön munkalapokra, hanem komplett excell fájlokba kellene másolnom, tehát a '2014q3.xlsx' fájl 'munkalap1' munkalapján vannak az adatok, a második oszlopba vannak a vonalkódok, aztán az adatok a következőkbe (pár oszlop lényegtelen a számomra).

    Ezekből kéne 'C oszlop' nevű új workbookot (.xlsx) fájlt létrehozni, amelybe átmásolom az adott sor bizonyos celláinak tartalmát, majd a fájlt bezárni, és folytatni a következő sorral.

    Szóval valami ilyesmi lenne (csak ez még mindig nem működik :DDD ):

    Sub WorkbooksAdd()

    Dim munkalap1 As Worksheet
    Dim wborig As Workbook
    Dim r As Integer, count As Integer

    Set wborig = "2014q3_int.xlsx"
    Set munkalap1 = ActiveSheet
    r = 5
    Do Until Not IsEmpty(munkalap1(r, B))

    Application.ScreenUpdating = False

    y = (wborig.munkalap1(r, C)

    strPath = ThisWorkbook.Path

    Workbooks.Add

    ActiveWorkbook.SaveAs Filename:=y.Name

    'Címsor másolása
    ActiveSheet.Cells(1, 1).Value = wborig.munkalap1.Cells(4, B)
    ActiveSheet.Cells(1, 2).Value = wborig.munkalap1.Cells(4, C)
    ActiveSheet.Cells(1, 3).Value = wborig.munkalap1.Cells(4, D)
    ActiveSheet.Cells(1, 4).Value = wborig.munkalap1.Cells(4, K)
    ActiveSheet.Cells(1, 5).Value = wborig.munkalap1.Cells(4, T)
    'Adatok másolása
    ActiveSheet.Cells(2, 1).Value = wborig.munkalap1.Cells(r, B)
    ActiveSheet.Cells(2, 2).Value = wborig.munkalap1.Cells(r, C)
    ActiveSheet.Cells(2, 3).Value = wborig.munkalap1.Cells(r, D)
    ActiveSheet.Cells(2, 4).Value = wborig.munkalap1.Cells(r, K)
    ActiveSheet.Cells(2, 5).Value = wborig.munkalap1.Cells(r, T)

    For Each wb In Application.Workbooks
    If Not wb.Name = ThisWorkbook.Name Then wb.Close SaveChanges:=True

    r = r + 1
    Loop

    Application.ScreenUpdating = True

    End Sub

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