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

• #38037 lcdtv aktív tag Mutt #38036

  Új Válasz 2018-05-15 16:25:15 #38037

  Ú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

  

  lcdtv

  aktív tag

  válasz Mutt #38036 üzenetére

  Látom Profi Mutt fórumtárs.
  Egyszer már kérdeztem és van is rá megoldás sajna fizetős , de ha nincs más akkor megveszem.
  Adott több munkalap azon belül 10 fül természetesen a fülek nevei ugyan azok. Ezeket kellene összevonnom egy munkalappá. Eddig csak egy fül volt, egy adott könyvtárba bemásoltam majd Indit gomb és összevonta az összes munkalapot ami a könyvtárba volt ( de csak az első fület )
  ez volt a kód ( ha esetleg ezt át lehetne alakítani hogy minden fület fűzzön össze )
  Sub ttt()
mappak = Array("D:\Mappa\")
If Dir("D:\Mappa\eredmeny.xlsx") <> "" Then Kill "D:\Mappa\eredmeny.xlsx"

For Each mappa In mappak
Set uj = Workbooks.Add
fajl = Dir(mappa & "*.xlsx")
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.xlsx"
uj.Close False
Next
MsgBox "Kész"
End Sub

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