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

问题描述:

我每月生成的文件类型相同。数据文件具有相同的名称,但它们位于不同的文件夹中。我想要的是将上个月的数据文件的特定列(计算结果)复制到新月的数据文件。我努力了 。但无法得到它。我收到这个错误。 “VBA对象不支持此属性或方法”Excel VBA:将excel列从一个文件复制到其他同名文件(不同文件夹中)

我的代码是

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 

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

+0

什么行以黄色突出显示? –

+0

ActiveSheet.Close SaveChanges:= False –

+2

尝试将代码更改为“ActiveWorkbook.Close(True)”。工作表不支持close方法。 –

ActiveSheet.Close SaveChanges:=True 

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

你忘了set下面的workbook对象行。

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

我认为这将有助于http://stackoverflow.com/questions/14396998/how-to-clear-memory-to-prevent-out-of-memory-error-in-excel-vba您需要终止无用的对象填满你的记忆 –

+0

它只适用于一个复制粘贴和循环不起作用 –

+0

而不是复制整个列,为什么不复制和粘贴范围。确定与您的范围相关的表单中数据的最后一个单元格,然后复制粘贴。单个列可以是300万个单元,这是很多内存。 –

要小心,在一行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 

使用复制|粘贴就像要求麻烦。相反,我使用Range.Copy ......指定目的如下所述:https://msdn.microsoft.com/en-us/library/office/ff837760.aspx

与复制|粘贴有威胁的是,在另一个Windows程序的中间(比如Word)中您可以使用复制|粘贴。这样你就可以将复制的列的内容粘贴到Word中。在同一时间你要粘贴到Excel的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 

此代码是更长时间和更多的资源,更可靠,更安全。

干杯