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

Question

我必须从多个以数字命名的 excel 文件（1.xlsx、2.xlsx、3.xlsx 等）中复制数据。我写了这个宏。它运行。但是没有复制发生，我运行宏所在的主工作簿仍然是空的。

Sub filecopy()
' The macro is running in the main file, which I saved as .xlsm    
' This main.xlsm is in the same folder as the files from which I copy the data

Dim Filename As String, Pathname As String,xx as Double
Activesheet.Usedrange.Clear 'I delete the current contents of the sheet

Pathname = ActiveWorkbook.Path
Filename = Dir(Pathname & "*.xlsx")
xx = 1 'the first column where the contents of the first file goes

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

您的代码中有 2 个错误：

1. \ 缺失 -> filename 为空

将Filename = Dir(Pathname & "*.xlsx")替换为Filename = Dir(Pathname & "\*.xlsx")

2。公式不正确 -> 文件名不完整

更改您的公式，例如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

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

Excel copy from file to file macro not working

excel

vba

copy