value通过文件vba粘贴一个循环

时间:2016-07-04 23:29:02

标签: vba loops paste

美好的一天,我在一个文件夹中有大约125个电子表格,并希望合并所有数据,我将每个文件放在一张纸上,从所有电子表格到另一个工作簿。我在文件夹中有一个循环文件​​,但它粘贴公式而不是实际值。我怎么能用下面的代码呢?我搜索过该网站,任何看起来可能有效的内容都会导致错误。任何有关这方面的帮助将非常感激。

Sub LoopThroughFilesInFolder()
Dim mainwb As Workbook
Dim wb As Workbook
Dim i As Integer

Set mainwb = ThisWorkbook
mainwb.Activate
Sheets("Engine").Select
Range("a2:c500").ClearComments

Set FileSystemObj = CreateObject("Scripting.FileSystemObject")
Set FolderObj = FileSystemObj.GetFolder("C:\Desktop\Vessel folder 2016") 'Use path of the folder

For Each fileobj In FolderObj.Files 'loop through the files

If fileobj.Name <> "Bronco.xlsm" And fileobj.Name <> "~$Bronco.xlsm" And      (FileSystemObj.GetExtensionName(fileobj.Path) = "xlsx" Or FileSystemObj.GetExtensionName(fileobj.Path) = "xlsm") Then

Application.DisplayAlerts = False
Set wb = Workbooks.Open(fileobj.Path)

'copy the results from the just opened wb
wb.Worksheets("ZenGarden").Select
lastcell = Range("a2:EQ5").SpecialCells(xlCellTypeLastCell).Address
Range("a2:" & lastcell).Select
Selection.Copy

'go to the mainworkbook and paste data
mainwb.Activate
Sheets("Engine").Select
If Range("a2").Value = "" Then
Range("a2").Select
Else
Range("a1").End(xlDown).Offset(1, 0).Select
End If
ActiveSheet.Paste

wb.Activate
wb.Save
wb.Close
mainwb.Activate

End If



Next fileobj



End Sub

1 个答案:

答案 0 :(得分:0)

使用Range.PasteSpecial xlPasteValues,例如:

'Copy the range into Clipboard
wb.Sheets(1).Range("A4").CurrentRegion.Copy
'Setup target range to paste Clipboard values
Dim targetRange As Range
Set targetRange = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)   
'Paste Values into target range
targetRange.PasteSpecial xlPasteValues

所以在你的情况下,它会看起来像一样

'copy the results from the just opened wb
wb.Worksheets("ZenGarden").Select
lastcell = Range("a2:EQ5").SpecialCells(xlCellTypeLastCell).Address
Range("a2:" & lastcell).Select
Selection.Copy

'go to the mainworkbook and paste data
mainwb.Activate
Dim targetSheet as Sheet
Set targetSheet = Sheets("Engine")
Dim targetRange As Range
Set targetRange = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)   
'Paste Values into target range
targetRange.PasteSpecial xlPasteValues