Question

在文件夹中我有30个相同格式的工作簿*，行数和列数相等。现在我想从所有工作簿中复制一些特定的列*。我要复制的列位于索引：＆＃39; F＆＃39;，＆＃39; J＆＃39;，＆＃39; N＆＃39;，＆＃39; R＆＃39;，＆＃39; V＆＃39;，＆＃39; Z＆＃39;，＆＃39; AD＆＃39;，＆＃39; AH＆＃39;，＆＃39; AL＆＃39;，＆＃39; AP＆＃39;，＆＃39; AT＆＃39;，＆＃39; AX＆＃39;。

*注1 =所有工作簿中只有一张工作表。 [N个工作簿= n张]

*注2 =这些列是固定的......只有这些列必须被提取。

所做的是：

复制＆＃39; F＆＃39;专栏

Sub CopyingRange()

Workbooks("workbook1 name").Sheets("Sheetname").Range("F2:F453").Copy Range("A1:A453")
Workbooks("workbook2 name").Sheets("Sheetname").Range("F2:F453").Copy Range("B1:B453")
...
Workbooks("workbookn name").Sheets("Sheetname").Range("F2:F453").Copy Range("Z1:Z453")

End Sub

对于专栏＆＃39; J＆＃39;同样的事情以及其他专栏。

问题：

1）我的过程非常基础。

2）工作簿必须在我工作时打开   运行程序。

3）耗时。

还有其他方法可以做到这一点.. 我想复制列而不打开工作簿。

Answer 1

您需要打开所有工作簿，复制所有数据，然后再次关闭所有工作簿。

这应该做得恰到好处：

Sub CopyingRange()
Dim ColNames As String
Dim ColS() As String
Dim ReportWs As Worksheet
Dim DestCol As Long
Dim WbCol As Collection
Dim wB As Workbook

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

ColNames = "F/J/N/R/V/Z/AD/AH/AL/AP/AT/AX"
ColS = Split(ColNames, "/")
ReportWs = ThisWorkbook.Sheets("SheetName")
DestCol = 1

WbCol.Add Workbooks.Open("C:/Path/workbook1 name.xlsx")
DoEvents
'... same for the others

For i = LBound(ColS) To UBound(ColS)
    For Each wB In WbCol
        ReportWs.Range(Col_Letter(DestCol) & "2:" & Col_Letter(DestCol) & "453").Value = _
            wB.Sheets(1).Range(ColS(i) & "2:" & ColS(i) & "453").Value
        DestCol = DestCol + 1
    Next wB
Next i
For Each wB In WbCol
    wB.Close
Next wB

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub


Function Col_Letter(lngCol As Long) As String
    Col_Letter = CStr(Split(Cells(1, lngCol).Address(True, False), "$")(0))
End Function

如何使用vba将列从已关闭的工作簿复制到另一个工作簿？

1 个答案: