Excel VBA:将excel列从一个文件复制到同名的其他文件(在不同的文件夹中)

时间:2015-06-22 07:11:29

标签: excel vba excel-vba

我每月都会生成相同类型的文件。数据文件具有相同的名称,但它们位于不同的文件夹中。我想要的是将上个月的数据文件的特定列(计算结果)复制到新月的数据文件。我试过了 。但无法得到它。我收到了这个错误。 “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

我想打开一个文件。复制一列。关闭它。打开另一个同名文件。粘贴它。 ....多数民众赞成......但错误发生了。请帮助我。提前谢谢。

3 个答案:

答案 0 :(得分:1)

set

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

您忘记workbook下面一行到Workbooks.Open (Pathname & vFile & "\" & fileName1) 个对象。

r = requests.get(urlas, params=params)
r.json()

答案 1 :(得分:1)

请注意在一行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

答案 2 :(得分:0)

使用复制|粘贴就像是在寻找麻烦。相反,我使用Range.Copy ... Destination,如下所述:https://msdn.microsoft.com/en-us/library/office/ff837760.aspx

使用“复制”|“粘贴”存在一个威胁,在另一个Windows程序(比如Word)的中间,您可能会使用“复制”|“粘贴”。这样您就可以将复制的列的内容粘贴到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

此代码较长并使用其他资源,但更可靠,更安全。

干杯