Excel从文件复制到文件macros不起作用

我必须从多个名称与数字（1.xlsx，2.xlsx，3.xlsx等）的Excel文件复制数据。 我写了这个macros。 它运行。 但没有复制发生，至于我运行macros的主要工作簿仍然是空的。

Sub filecopy() ' The macro is running in the main file, wich I saved as .xlsm ' This main.xlsm is in the same folder as the files from wich I copy the data Dim Filename As String, Pathname As String,xx as Double Activesheet.Usedrange.Clear 'I delete the current contents fo the sheet Pathname = ActiveWorkbook.Path Filename = Dir(Pathname & "*.xlsx") xx = 1 'the first column where the contents of the first file go Do While Len(Filename) > 0 Cells(1, xx).Formula = "='[" & Filename & "]Sheet1'!A1" Cells(2, xx).Formula = "='[" & Filename & "]Sheet1'!B2" Cells(3, xx).Formula = "='[" & Filename & "]Sheet1'!C3" xx = xx + 1 'next file next column Filename = Dir() Loop ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 'every formula goes to value MsgBox "Work Complete", vbInformation End Sub 

Answer 1

你的代码有两个错误：

1. \ is missing – > filename是空的

用Filename = Dir(Pathname & "*.xlsx") Filename = Dir(Pathname & "\*.xlsx") Filename = Dir(Pathname & "*.xlsx")replaceFilename = Dir(Pathname & "*.xlsx") Filename = Dir(Pathname & "\*.xlsx")

2.公式不正确 – >不完整的文件名

Cells(1, xx).Formula = "='" & Pathname & "\[" & Filename & "]Sheet1'!A1" Cells(1, xx).Formula = "='[" & Filename & "]Sheet1'!A1" Cells(1, xx).Formula = "='" & Pathname & "\[" & Filename & "]Sheet1'!A1"

Answer 2

如何解决这样的问题：

 Pathname = ActiveWorkbook.Path 'Be sure is the rigth path Filename = Dir(Pathname & "\*.xlsx") 'I've addedd a "\" xx = 1 Do While Len(Filename) > 0 If Filename <> ThisWorkbook.Name Then Set mFile = Workbooks.Open(Pathname & "\" & Filename) Else GoTo NextFile End If With mFile.ActiveSheet 'Use the sheet you need here Cells(1, xx) = .Cells(1, 1).Value Cells(2, xx) = .Cells(2, 1).Value Cells(3, xx) = .Cells(3, 1).Value End With xx = xx + 1 'next file next column Application.DisplayAlerts = False mFile.Close savechanges:=False Application.DisplayAlerts = True Set mFile = Nothing NextFile: Filename = Dir() Loop