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

• #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

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