Copy a range of cells from multiple worksheets in a folder , and paste them one after other in column wise for some range and row wise for other range with out replacing the existing data

I Need to copy a column from many worksheets in a folder and paste them in master worksheet or any other column wise. I need the particular column to be copied and pasted in columns of master work book. For example I have 10 workbooks in a folder containing similar type of data. I need to copy column number 6 of all these worksheets and copied to master or a new workbook from column 1 to 10 in a way column 1 of new workbook should be column 6 of workbook 1 in the folder and column 2 of new workbook should be column 6 of workbook 2 in the folder and so on ...

similarly

And a range of cells like A1:A7 from all these workbooks to be copied row wise in another new workbook.

Yes the columns to be copied are always in sheet 1

The range of cells copied also are in sheet 1 always

Can we set the path of the folder as the path from where the code will be running

Extension is .xlsx

Yes the folder has only the work sheets and the worksheet with the code running

Hi , Thank you for the code..

But I am getting an error while running the code at the below line . What could be the reason

Set srcWB = Workbooks.Open(strPath & strExtension)

Quote from Mumps

Place this macro in your Master workbook and make sure that it contains a sheet named "Master". Save the workbook as a macro-enabled file in the same folder as the source files. Run the macro. It will copy the columns to the Master sheet and create another workbook with the A1:A7 ranges from each source file.

Code

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, desWS1 As Worksheet, desWS2 As Worksheet, srcWB As Workbook, lCol As Long
    Set desWS1 = ThisWorkbook.Sheets("Master")
    Application.Workbooks.Add 1
    Set desWS2 = Sheets(1)
    strExtension = Dir(ThisWorkbook.Path & "\" & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            With Sheets(1)
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                lCol = desWS1.Cells(1, desWS1.Columns.Count).End(xlToLeft).Column + 1
                .Range("F1:F" & LastRow).Copy desWS1.Cells(1, lCol)
                .Range("A1:A7").Copy
                With desWS2
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
                End With
            End With
            .Close False
        End With
        strExtension = Dir
    Loop
    desWS1.Columns(1).Delete
    Application.ScreenUpdating = True
End Sub

Display More

Hi , Thank you for the code..

But I am getting an error while running the code at the below line . What could be the reason

Set srcWB = Workbooks.Open(strPath & strExtension)

Quote from davesexcel

strPath is not a thing, I assume it was a leftover from wherever the sample code originated. Possibly delete "strPath &"

Tried It didnt work and I still get that error we couldn't find Image30....files . Even though they are present in that folder

Yes it does have xlsx extension

I have attached the file and screen Shot for your reverence . I have also highlighted the regions to be copied.

Thank you .

All the files has same format

I am still getting that error, even when I tried with other files . What could be the issue.

Or will you change the code to enter the path so I can enter the path and try

I am running it from this file keeping it in the same folder .

Hey Now the code is running but I am getting another error with first workbook column copied .

I have attached the screenshots