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

• #21896 Delila_1 veterán zhari #21895

  Új Válasz 2014-06-05 14:32:23 #21896

  Ú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 zhari #21895 üzenetére

  Küldöm a másolással, és értékbeillesztéssel kiegészített teszt makrót. Írd át a meghajtó betűjelét!

  Sub teszt()
  Dim Args As TFindFile, usor As Long, WS As Worksheet
  Dim Siker As Boolean, i As Long
  With Args
  '**************** itt a saját meghajtód nevét írd be! *******
  .StartFolder = "F:\"
  '****************************************************************
  .FileName = InputBox("fájlnév vagy része") & "*"
  .Extension = "xlsx"
  End With
  Siker = FindFile(Args:=Args)
  Set WS = ActiveWorkbook.Sheets("Munka1")
  
  If Siker Then
  For i = 1 To UBound(Args.Findings)
  usor = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
  Workbooks.Open FileName:=Args.Findings(i)
  Range("Munka1!A1:L7").Copy
  WS.Range("A" & usor).PasteSpecial xlPasteValues
  ActiveWorkbook.Close
  Next
  Else
  MsgBox "Nincs találat."
  End If
  If Args.ErrorCount > 0 Then
  MsgBox Args.ErrorCount & " probléma merült fel, lásd Hibák munkalap."
  End If
  End Sub

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