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

• #22172 slashing senior tag Delila_1 #22171

  Új Válasz 2014-06-28 08:12:40 #22172

  Ú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

  

  slashing

  senior tag

  válasz Delila_1 #22171 üzenetére

  Uhh ez tök jól működik és naivan azt hittem az összefűzés a másik makróval már gyerek játék lesz de valamiért hibaüzenetet dob ki miután megnyitotta az első fájlt(Object variable or With block variable not set). Szerintem az zavar be neki hogy nem tudja hol dolgozzon vagy valami hasonló most így néz ki kb. csak összemásoltam a kettőt. A kiemelt résznél van gondolom a hiba hogy melyik workbook-al mit szeretnék csinálni de nem jövök rá mit kéne átírnom hozzá...

  Sub ProcessFiles()
  Dim Filename, Pathname As String
  Dim wb As Workbook

  Pathname = ActiveWorkbook.Path & "\Files\"
  Filename = Dir(Pathname & "*.xls")
  Do While Filename <> ""
  Set wb = Workbooks.Open(Pathname & Filename)
  it wb
  wb.Close SaveChanges:=Yes
  Filename = Dir()
  Loop
  End Sub

  Sub it(wb As Workbook)
  With wb
  'Do your work here
  Dim cell As Range, usor As Long
  Dim selectRange As Range

  For Each cell In ActiveSheet.Range("A3:A1000")
  If (cell.Value <> "") Then
  If selectRange Is Nothing Then
  Set selectRange = cell
  Else
  Set selectRange = Union(cell, selectRange)
  End If
  End If
  Next cell

  usor = Sheets("mega").Range("A" & Rows.Count).End(xlUp).Row + 1
  selectRange.Copy
  Sheets("mega").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
  End With
  End Sub

  Úgy kéne összefűzni a két makrót hogy van egy összesítés.xls amiben csak egy makróindító gomb van illetve a mega munkalap. Ha elindítom a gombbal a makrót akkor a files könyvtárban lévő fájlokból kimásolgatja ide az a3:a1000 nem üres celláit transzponálva egymás alá.

  [ Szerkesztve ]

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