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

• #22413 Delila_1 veterán Brutis #22408

  Új Válasz 2014-07-11 16:37:39 #22413

  Ú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

  

  Delila_1

  veterán

  válasz Brutis #22408 üzenetére

  Szívesen.

• #22367 Delila_1 veterán Brutis #22358

  Új Válasz 2014-07-09 15:46:57 #22367

  Ú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

  

  Delila_1

  veterán

  válasz Brutis #22358 üzenetére

  Azt mondod, hogy a teljes lapokat kell bemásolni. Akkor nem számít az egyes lapokon elfoglalt terület mérete..

  3 makrót írtam, e Talloz-zal indíts, ez hívja a Megnyitas-t, az meg a Masolas-t.
  A Masolas makróban írd át a Proba.xls-t a saját gyűjtő fájlod nevére.

  Sub Talloz()
  Dim FD, utvonal As String
  Set FD = Application.FileDialog(4)
  With FD
  .AllowMultiSelect = False
  .Show
  If .SelectedItems.Count = 0 Then
  utvonal = ""
  Else
  utvonal = .SelectedItems(1)
  End If
  End With
  utvonal = utvonal & "\"
  
  Megnyitas utvonal
  End Sub

  Sub Megnyitas(utvonal)
  Dim FN As String
  
  ChDir utvonal
  FN = Dir(utvonal & "*.xls", vbNormal)
  Do
  If FN <> "." And FN <> ".." Then
  Workbooks.Open Filename:=utvonal & FN
  Masolas FN
  End If
  FN = Dir()
  Loop Until FN = ""
  End Sub

  Sub Masolas(FN)
  Dim lap As Integer, ucso As Integer
  
  ucso = Workbooks("Proba.xls").Sheets.Count '****
  For lap = 1 To Sheets.Count
  Sheets(lap).Select
  ActiveSheet.Copy After:=Workbooks("Proba.xls").Sheets(ucso) '****
  ucso = ucso + 1
  ActiveWindow.ActivatePrevious
  Next
  ActiveWindow.Close False
  End Sub

• #22346 Delila_1 veterán Brutis #22345

  Új Válasz 2014-07-08 17:39:21 #22346

  Ú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

  

  Delila_1

  veterán

  válasz Brutis #22345 üzenetére

  Szükség van az Application.FileDialog-ra, Nem mindig azonos könyvtárból hívod be a fájlokat? Mi a könyvtár útvonala?

  Minden füzet összes lapjáról az A1:L43 tartományt kell bemásolnod? Vannak a másolandóban képletek? Azokkal együtt kell másolni, vagy az értéküket?

  A gyűjtő füzetben az egyes tartományok egymás alá kerüljenek? Egy előző hsz-ben azt írtad, hogy a munkalapok nevei az A oszlopban legyenek. Ebből az következik, hogy a bemásolt tartományok a B-ben kezdődjenek.

  Ha a sok kérdésre válaszolsz, holnap összehozom, feltéve, hogy valaki közben meg nem oldja.

• #22345 Brutis újonc Brutis #22340

  Új Válasz 2014-07-08 16:20:37 #22345

  Ú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

  

  Brutis

  újonc

  válasz Brutis #22340 üzenetére

  Ennyire jutottam , de még mindig hibás.
  És sajnos nem boldogulok vele
  Sub talloz()

  'mappa ki tallózása
  With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  If .Show = -1 Then

  File_name = .SelectedItems(1)
  End If
  End With

  Call main(File_name)

  End Sub

  Sub main(File_name)

  'ForReading Megnyitás csak olvasásra 1
  'ForWriting 'Megnyitás csak írásra 2
  'ForAppending Megnyitás, hogy a fájl végére való íráshoz 8

  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Könyvtár = fso.GetFolder(File_name)
  Set Fájlok = Könyvtár.Files

  Set munka = Workbooks()
  'a mappában lévő fájlok bejárása
  For Each Fájl In Fájlok
  'akt beállítás és megnyitás
  Set akt = Workbooks.Open(fileName:=Fájl)

  munka.Worksheets.Add.Name = akt.Worksheets(i).Name
  For i = 1 To munka.Worksheets.Count

  akt.Name ("Aktuális")
  akt.Worksheets(i).Range("A1:L43").Copy Destination:=munka.Worksheets().Rows(1).Columns("a")
  'For i = 1 To munka.Worksheets.Count
  'akt.name a munkafüzet neve akt.worksheets(i).name munkalap neve
  Next i
  'akt. bezárás

  akt.Close

  Next Fájl

  'Call vege

  End Sub

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