在一張Excel表格中合併多個Excel文件而不復制公式和複製數據

Question

我嘗試將多個Excel文件合併到一個主工作表中。 下面的代碼完美地工作，因爲沒有複製合併的數據。我唯一的問題是複製其他文件中的公式......我需要的僅僅是值。

我嘗試代碼的某些部分更改爲

PasteSpecial Paste:=xlPasteValues 

Error Image

Error 400 Image

比我得到一個錯誤（

代碼中使用：

Sub sumit() 

Dim fso As New FileSystemObject 

Dim NoOfFiles As Double 
Dim counter As Integer 
Dim r_counter As Integer 
Dim s As String 
Dim listfiles As Files 
Dim newfile As Worksheet 
Dim mainworkbook As Workbook 
Dim combinedworksheet As Worksheet 
Dim tempworkbook As Workbook 
Dim rowcounter As Double 
Dim rowpasted As Integer 
Dim delHeaderRow As Integer 
Dim Folderpath As Variant 
Dim headerset As Variant 
Dim Actualrowcount As Double 
Dim x As Long 
Dim Delete_Remove_Blank_Rows As String 


Range("A:A").Clear 
Range("B:B").Clear 
Range("C:C").Clear 

Folderpath = ActiveWorkbook.Sheets(2).Range("I7").Value 
headerset = ActiveWorkbook.Sheets(2).Range("F4").Value 
Delete_Remove_Blank_Rows = ActiveWorkbook.Sheets(2).Range("F3").Value 

NoOfFiles = fso.GetFolder(Folderpath).Files.Count 
Dim Files_Count_No_Of_Rows_In_Sheets(1000) As Double 'declare the array of the size of no of files in the folder 


Set listfiles = fso.GetFolder(Folderpath).Files 
counter = 0 
r_counter = 1 
rowcounter = 1 
Actualrowcount = 0 

For Each fls In listfiles 
counter = counter + 1 
Range("A" & counter).Value = fls.Name 
Next 
'MsgBox ("count of files in folder is " & NoOfFiles) 
Set mainworkbook = ActiveWorkbook 
Set combinedworksheet = mainworkbook.Sheets(2) 
mainworkbook.Sheets(3).UsedRange.Clear 
'MsgBox ("Sheet is clear for the data to be copied") 
For i = 1 To NoOfFiles 
mainworkbook.Sheets("Combine").Activate 
'MsgBox ("Sheet 3 is Activated") 
mainworkbook.Sheets("Combine").Range("A" & rowcounter).Select 
Application.Workbooks.Open (Folderpath & "\" & Range("A" & i).Value) 
Set tempworkbook = ActiveWorkbook 
Set newfile = ActiveSheet 
rowpasted = rowcounter 
'MsgBox ("pointer at " & rowpasted) 
newfile.UsedRange.Copy 
'MsgBox ("Data is copied") 
mainworkbook.Sheets(3).Paste 
'MsgBox ("Data is pasted successfully") 
'MsgBox ("Blank rows has been deleted " & Remove_Blank_Rows & " " & headerset) 
If Delete_Remove_Blank_Rows = "Yes" Then 
'If Remove_Blank_Rows = Yes Then 
'MsgBox ("Blank rows has been deleted" & Delete_Remove_Blank_Rows) 
For x = mainworkbook.Sheets("Combine").Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1 
If WorksheetFunction.CountA(mainworkbook.Sheets("Combine").Rows(x)) = 0 Then 
mainworkbook.Sheets("Combine").Rows(x).Delete 
'MsgBox ("Blank rows has been deleted" & Remove_Blank_Rows) 
End If 
Next 
End If 
rowcounter = mainworkbook.Sheets(3).UsedRange.Rows.Count + 1 
'MsgBox ("row counter is updated" & rowcounter) 
rowpasted = rowcounter - rowpasted 
'MsgBox ("No fo rows pasted" & rowpasted) 
delHeaderRow = rowcounter - rowpasted 
'MsgBox ("Which row to delete" & delHeaderRow) 
'MsgBox ("Pointer at row beforw deletion" & rowpasted) 
If headerset = "Yes" Or headerset = "YES" Or headerset = "yes" Then 
If delHeaderRow <> 1 Then 
mainworkbook.Sheets(3).Rows(delHeaderRow).EntireRow.Delete 
rowcounter = rowcounter - 1 
rowpasted = rowpasted - 1 
Else 
End If 
Else 
End If 
'MsgBox ("Header deleted") 
'MsgBox ("row counter is updated" & rowcounter) 
combinedworksheet.UsedRange.ClearOutline 
'combinedworksheet. 
tempworkbook.Close 
'MsgBox ("no of rows are abt to get pasted in sheet 1") 

Files_Count_No_Of_Rows_In_Sheets(i) = rowpasted 
Actualrowcount = Actualrowcount + rowpasted 
Next i 
mainworkbook.Sheets(1).UsedRange.ClearContents 
For Each fls In listfiles 
r_counter = r_counter + 1 
mainworkbook.Sheets(1).Range("A" & r_counter).Value = fls.Name 
mainworkbook.Sheets(1).Range("B" & r_counter).Value = Files_Count_No_Of_Rows_In_Sheets(r_counter - 1) 
mainworkbook.Sheets(1).Range("A" & r_counter, "B" & r_counter).Borders.Value = 1 

Next 
mainworkbook.Sheets(1).Range("B" & r_counter + 1).Interior.ColorIndex = 46 
mainworkbook.Sheets(1).Range("B" & r_counter + 1).Value = Actualrowcount 
mainworkbook.Sheets(1).Range("B" & r_counter + 1).Borders.Value = 1 
mainworkbook.Sheets(1).Range("A1", "B1").Interior.ColorIndex = 46 
mainworkbook.Sheets(1).Range("A1", "B1").Borders.Value = 1 
mainworkbook.Sheets(1).Range("A1").Value = "Files List" 
mainworkbook.Sheets(1).Range("B1").Value = "No Of Rows" 

MsgBox ("List of Files are Availabe in sheet 1..Total " & NoOfFiles & " Files Combiled") 
End Sub 

Answer 1

在錯誤圖像中有mainworkbook.Sheets(3).Paste xlPasteValues這是錯誤的，應該是mainworkbook.Sheets(3).Cells(rowcounter, 1).PasteSpecial xlPasteValues。