August 21, 2019

Copy Non Adjacent Cells Data from Multiple Workbooks

How to copy non adjacent cells data from multiple workbooks and paste into a master workbook automatically using VBA.

We receive multiple excel files with unsorted data without any headers and we need to select some specific data from those workbooks, close that workbook and paste it into the Master sales workbook under some specific headers; then again open another workbook and repeat the procedure over again.
Even though the data is unsorted, the position for each data is very specific and does not change in any worksheet, Can this process be automated using VBA? Please note all these excel files are stored in same folder and with the master sales workbook. Watch the video below:

Copy Non Adjacent Cells Data from Multiple Workbooks and Paste in master workbook automatically using VBA

Watch this video on YouTube.

Here’s the complete VBA code to copy non adjacent cells data from multiple workbooks and paste in master workbook automatically:

Sub copyNonAdjacentCellsData()
Dim myFile As String, path As String
Dim erow As Long, col As Long

path = “c:\copy-non-contiguous-cells-data\”
myFile = Dir(path & “*.xlsx”)

Application.ScreenUpdating = False

Do While myFile <> “”
Workbooks.Open (path & myFile)
Windows(myFile).Activate

Set copyrange = Sheets(“sheet1”).Range(“E9,C13,B7,E3,B18”)

Windows(“master-wbk.xlsm”).Activate

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

col = 1
For Each cel In copyrange
cel.Copy

Cells(erow, col).PasteSpecial xlPasteValues

col = col + 1

Next

Windows(myFile).Close savechanges:=False
myFile = Dir()
Loop
Range(“A:E”).EntireColumn.AutoFit

Application.ScreenUpdating = True

End Sub

3 thoughts on “Copy Non Adjacent Cells Data from Multiple Workbooks

  1. Sub CopyCells()

    Dim myFile As String, path As String
    Dim erow As Long, col As Long
    Dim sheetname As String
    sheetname = ActiveSheet.Name

    path = “c:\FINALE\”
    myFile = Dir(path & “*.xslx”)

    Application.ScreenUpdating = False

    Do While myFile “”
    Workbooks.Open (path & myFile)
    Windows(myFile).Activate

    Set copyRange = Sheets(“sheetname”).Range(“Q40,Q79,Q118,Q157,Q274”)

    Windows(“ZMASTER.xslm”).Activate

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    col = 1
    For Each cel In copyRange
    cel.Copy

    Cells(erow, col).PasteSpecial xlPasteValues
    col = col + 1

    Next

    Windows(myFile).Close savechanges:=False
    myFile = Dir()
    Loop
    Range(“A:E”).EntireColumn.AutoFit
    Application.ScreenUpdating = True

    End Sub

    This Code wouldn’t compile and there is no message
    I have made some changes , first one is sheetname as sheetname for each workbook will be different in my case

Comments are closed.