Excel VBA：将excel列从一个文件复制到相同名称的另一个文件（在不同文件夹中）

Question

我有每月生成的相同类型的文件。 数据文件具有相同的名称，但它们位于不同的文件夹中。 我想要的是将上个月的数据文件的特定列（计算结果）复制到新月的数据文件。 我努力了 。 但无法理解。 我收到此错误。 “ VBA对象不支持此属性或方法”

我的代码是

Private Sub CommandButton1_Click()

 Dim CSVfolder, CSVfolder1, CSVfolder2 As String
 Dim XlsFolder, XlsFolder1, XlsFolder2 As String
 Dim fname, fname1, fname2 As String
 Dim wBook As Workbook
 Dim vArr, vArr1, vArr2
 Dim vFile, vFile1, vFile2
 vArr = Array("Bangalore")
 CSVfolder = "C:\Charts\0\"
 CSVfolder1 = "C:\Charts\1\"
 CSVfolder2 = "C:\Charts\2\"
 XlsFolder = "C:\Charts\0\"
 XlsFolder1 = "C:\Charts\1\"
 XlsFolder2 = "C:\Charts\2\"
vArr1 = Array("Bangalore")
vArr2 = Array("Bangalore")
Dim fileName, Pathname As String
Dim WB, WB1, WB2 As Workbook

Pathname = "c:\Charts\0\"
Dim fileName1, Pathname1 As String
Pathname1 = "c:\Charts\1\"
For Each vFile1 In vArr1
fileName1 = Dir(Pathname1 & vFile1 & "\" & "*.xlsx")
Do While fileName1 <> ""
Set WB1 = Workbooks.Open(Pathname1 & vFile1 & "\" & fileName1)
    WB1.Application.ScreenUpdating = False
    WB1.ActiveSheet.Columns("M").Copy
    ActiveSheet.Close SaveChanges:=False

    Workbooks.Open (Pathname & vFile & "\" & fileName1)
    ActiveSheet.Columns("C").Select
    ActiveSheet.Paste
    ActiveSheet.Close SaveChanges:=True
Loop
Next

Dim fileName2, Pathname2 As String
Pathname2 = "c:\Charts\2\"
For Each vFile2 In vArr2
fileName2 = Dir(Pathname1 & vFile2 & "\" & "*.xlsx")
Do While fileName2 <> ""
Set WB2 = Workbooks.Open(Pathname2 & vFile2 & "\" & fileName2)
    WB2.Application.ScreenUpdating = False
    WB2.ActiveSheet.Columns("M").Copy
    WB2.ActiveSheet.Close SaveChanges:=False

    Workbooks.Open (Pathname & vFile & "\" & fileName2)
    ActiveSheet.Columns("D").Select
    ActiveSheet.Paste
    ActiveSheet.Close SaveChanges:=True
Loop
Next

End Sub

我想打开一个文件。 复制列。 关闭它。 打开另一个同名文件。 粘贴。 ....就这样...但是会发生错误。 请帮助我。 提前致谢。

Answer 1

ActiveSheet.Close SaveChanges:=True

您无法关闭工作表。 您只能关闭工作簿。 更改您要关闭的工作簿。

您忘记将下面的行set为workbook对象。

Workbooks.Open (Pathname & vFile & "\" & fileName1)

Answer 2

注意在一行Dim CSVfolder, CSVfolder1, CSVfolder2 As String上声明多个变量Dim CSVfolder, CSVfolder1, CSVfolder2 As String因为在这里您仅将最后一个声明为String ，其余都声明为Variant 。 如果您希望将它们排成一行，则每次将Dim CSVfolder As String, CSVfolder1 As String, CSVfolder2 As String都声明类型。

打开工作簿时，请始终Set工作簿变量以引用它。

不要重复代码块，而是将代码放入另一个过程或函数中，然后调用它。

使用Dir函数遍历文件时，您需要记住再次调用Dir ，但循环内没有参数：

filename = Dir("some_path")

Do While filename <> ""
    ' do something here
    ...
    filename = Dir ' this finds the next filename
Loop

在您现有的代码中，您可以使用vFile变量，但是没有在任何地方设置它。 您设置了vArr变量，但没有在任何地方使用它。

这是代码外观的示例。

Private Sub CommandButton1_Click()

Dim CSVfolder As String, CSVfolder1 As String, CSVfolder2 As String
Dim XlsFolder As String, XlsFolder1 As String, XlsFolder2 As String
Dim vArr As Variant, vArr1 As Variant, vArr2 As Variant

Dim Pathname As String
Dim Pathname2 As String
Dim Pathname1 As String

    vArr = Array("Bangalore")   ' never gets used
    CSVfolder = "C:\Charts\0\"
    CSVfolder1 = "C:\Charts\1\"
    CSVfolder2 = "C:\Charts\2\"
    XlsFolder = "C:\Charts\0\"
    XlsFolder1 = "C:\Charts\1\"
    XlsFolder2 = "C:\Charts\2\"
    vArr1 = Array("Bangalore")
    vArr2 = Array("Bangalore")

    Pathname2 = "c:\Charts\2\"

    Pathname = "c:\Charts\0\"
    Pathname1 = "c:\Charts\1\"

    Application.ScreenUpdating = False

    CopyTheColumn vArr1, Pathname1, Pathname, "M", "C"

    CopyTheColumn vArr2, Pathname2, Pathname, "M", "D"

    Application.ScreenUpdating = True

End Sub

Private Sub CopyTheColumn(ByRef fileNamesArray As Variant, ByRef sourcePath As String, ByRef destPath As String, ByRef sourceColumnLetter As String, ByRef destColumnLetter As String)

' Copies the sourceColumnLetter column from all files found in sourcePath
' and pastes into destColumnLetter in file with same name in destPath

Dim vFile As Variant
Dim sourceFileName As String, destFileName As String
Dim sourceBook As Workbook, destBook As Workbook

    For Each vFile In fileNamesArray
        sourceFileName = Dir(sourcePath & vFile & "\" & "*.xlsx")
        Do While sourceFileName <> ""

            Set sourceBook = Workbooks.Open(sourcePath & vFile & "\" & sourceFileName)
            sourceBook.ActiveSheet.Columns(sourceColumnLetter).Copy
            sourceBook.Close SaveChanges:=False

            Set destBook = Workbooks.Open(destPath & vFile & "\" & sourceFileName)
            destBook.ActiveSheet.Columns(destColumnLetter).Paste
            destBook.Close SaveChanges:=True

            sourceFileName = Dir
        Loop
    Next

End Sub

Answer 3

使用Copy | Paste就像在麻烦一样。 相反，我使用Range.Copy ... Destination，如此处所述： https ://msdn.microsoft.com/zh-cn/library/office/ff837760.aspx

使用Copy | Paste可能会威胁到另一个Windows程序（例如Word）的中间位置，您可能会使用Copy | Paste。 这样，您将把复制的列的内容粘贴到Word中。 同时，您将粘贴到Word的Excel内容中。 这是因为所有Windows程序共享同一剪贴板。

使用Range.Copy | Destination更加困难，因为您必须同时打开两个文件，但是Excel不允许打开两个具有相同名称的文件。 解决方案是使用临时文件并使用以下伪代码：

Sub CopyDestination(SourceFile, Path1, Path2, MyRange)
   Set Temp as Workbook
   Set File1 = open Path1 & SourceFile
   File1.Sheet.MyRange.Copy Destination:= Temp.Sheet.MyRange
   File1.Close False
   Set File2 = open Path2 & SourceFile
   Temp.Sheet.MyRange.Copy Destination:= File2.Sheet.MyRange
   File2.Close True
   Temp.Clear
End Sub

该代码更长，使用更多资源，但更可靠，更安全。

干杯