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

• #21129 Louro őstag

  Új Válasz 2014-03-28 13:21:22 #21129

  Ú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

  

  Louro

  őstag

  van a lenti makróm. Lefut, de valamiért csak az első forrásfájlból menti ki az adatot és illeszti az újba. (Filterezésből csak egy egyszerű feltételt adtam meg, hogy ne most számolgasson.) Miért nem húzhatja be a többi fájlt? Van ötletetek?

  Sub ProcessFiles()
  Dim Filename, Pathname As String
  Dim SourceWorkbook As Workbook
  'Hol vannak a fájlok
  Pathname = ActiveWorkbook.Path & "\Files\"
  Filename = Dir(Pathname & "*.xlsx")
  'Célfájl létének ellenőrzése, létrehozása, megnyitása
  Dim TargetFile As String
  Dim TargetWorkbook As Workbook
  TargetFile = "c:\Users\User\Desktop\temp.xlsx"
  If Len(Dir(TargetFile)) = 0 Then
  Workbooks.Add
  ActiveWorkbook.SaveAs TargetFile
  Else
  Set TargetWorkbook = Workbooks.Open(TargetFile)
  End If
  ActiveSheet.Name = "Yes"
  'Menjen végig minden fájlon
  Do While Filename <> ""
  Set SourceWorkbook = Workbooks.Open(Pathname & Filename)
  'Forrásfájlból a szükséges adatok kinyerése és vágólapra másolása
  '
  'Sorok megszámlálása
  Dim CountOfRowsSourceTable, CountOfRowsTargetTable As Long
  CountOfRowsSourceTable = Range("A" & Rows.Count).End(xlUp).Row
  'Filterezés és a találatok kijelölése, vágólapra másolása
  Range(Cells(1, 1), Cells(CountOfRowsSourceTable, 5)).Select
  Selection.Copy
  'Célfájlra átváltás
  Workbooks("temp.xlsx").Activate
  'Célfájl utolsó, adatot tartalmazó sorának azonosítása
  CountOfRowsTargetTable = Range("A" & Rows.Count).End(xlUp).Row
  'Vágólap célfáljba másolása
  Range("A" & CountOfRowsTargetTable).Select
  ActiveSheet.Paste
  'Ezt csak azért, hogy a vágólapot kiürítsem.
  Range("A1").Copy
  'Forrásfájl bezárása
  SourceWorkbook.Close SaveChanges:=True
  Filename = Dir()
  Loop
  'Célfálj mentése és bezárása
  TargetWorkbook.Close SaveChanges:=True
  End Sub

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