Добрый вечер.
Просьба помочь подправить макрос. Я нашел этот макрос на просторах интернета и немного подредактировал под свои нужды, но никак не могу сделать так чтобы вставлялись значения, а не формулы(. Уже кучу всего пробовал в течении всего дня но не получается, то ошибки выдает, то ничего не делает.
Sub KOLLIAK()
Dim myPath$, mask$, f$, i%, t As Date
Dim myFolder As Object, myFile As Object, Rn As Range
myPath = "путь к файлу"
ThisWorkbook.Worksheets(1).UsedRange.Clear
With CreateObject("Scripting.FileSystemObject")
Set myFolder = .GetFolder(myPath)
For Each myFile In myFolder.Files
If myFile.Name Like "*.xlsm*" Then
If CDate(myFile.DateCreated) > t Then
t = CDate(myFile.DateCreated)
f = myFile.Name
End If
End If
Next
End With
Set myFolder = Nothing
myPath = myPath & "\" & f
Workbooks.Open myPath
With ActiveWorkbook.Worksheets(1)
Set Rn = Intersect(.Range("A16", .Range("A16").SpecialCells(xlLastCell)), .Range("A16:A300"))
End With
With ThisWorkbook.Worksheets(1)
Rn.Copy .Range("A2")
End With
With ActiveWorkbook.Worksheets(1)
Set Rn = Intersect(.Range("L16", .Range("L16").SpecialCells(xlLastCell)), .Range("L16:L300"))
End With
With ThisWorkbook.Worksheets(1)
Rn.Copy .Range("B2")
End With
ActiveWorkbook.Close
Просьба помочь подправить макрос. Я нашел этот макрос на просторах интернета и немного подредактировал под свои нужды, но никак не могу сделать так чтобы вставлялись значения, а не формулы(. Уже кучу всего пробовал в течении всего дня но не получается, то ошибки выдает, то ничего не делает.
Sub KOLLIAK()
Dim myPath$, mask$, f$, i%, t As Date
Dim myFolder As Object, myFile As Object, Rn As Range
myPath = "путь к файлу"
ThisWorkbook.Worksheets(1).UsedRange.Clear
With CreateObject("Scripting.FileSystemObject")
Set myFolder = .GetFolder(myPath)
For Each myFile In myFolder.Files
If myFile.Name Like "*.xlsm*" Then
If CDate(myFile.DateCreated) > t Then
t = CDate(myFile.DateCreated)
f = myFile.Name
End If
End If
Next
End With
Set myFolder = Nothing
myPath = myPath & "\" & f
Workbooks.Open myPath
With ActiveWorkbook.Worksheets(1)
Set Rn = Intersect(.Range("A16", .Range("A16").SpecialCells(xlLastCell)), .Range("A16:A300"))
End With
With ThisWorkbook.Worksheets(1)
Rn.Copy .Range("A2")
End With
With ActiveWorkbook.Worksheets(1)
Set Rn = Intersect(.Range("L16", .Range("L16").SpecialCells(xlLastCell)), .Range("L16:L300"))
End With
With ThisWorkbook.Worksheets(1)
Rn.Copy .Range("B2")
End With
ActiveWorkbook.Close