1

In a Folder i have 30 workbooks* of same format, equal number of rows and columns.Now i want copy a number of specific columns* from all the workbooks. columns i want to copy are at index: 'F', 'J', 'N', 'R', 'V', 'Z', 'AD', 'AH', 'AL', 'AP', 'AT', 'AX'.

*Note 1= there is only one sheet in all workbooks. [N workbooks = n sheets]

*Note 2= these columns are fixed...only these columns must be extracted.

what is have done is :

copying 'F' column

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

same thing for Column 'J' and for other columns.

problems:

1) my process is very basic.

2) workbooks must be open while i am running the program.

3) time consuming.

Is there any other way to do this.. i want to copy the columns without opening the workbooks.

R3uK
  • 14,417
  • 7
  • 43
  • 77
kumud
  • 43
  • 1
  • 1
  • 6
  • If you have multiple problems then you should divide your post into multiple posts / questions. After all, this site is here to solve programming problems and not business / personal requirements. Problem 1 doesn't seem to be a problem if it works. Problem 2 is addressed here: http://stackoverflow.com/questions/9311188/copy-data-from-closed-workbook-based-on-variable-user-defined-path Problem 3 is probably solved with problem 2 being solved. If that's not the case then you can post this as a new problem on [Code Review](http://codereview.stackexchange.com/) – Ralph Oct 13 '16 at 09:18

1 Answers1

0

You'll need to open all the workbooks, copy all the data and then close all the workbooks again.

This should do it properly :

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
R3uK
  • 14,417
  • 7
  • 43
  • 77