Posts by divya004

Thank you @Mumps for initiating and being through all the way . And putting your efforts to resolve the issue. As I was new to forum I had trouble explaining the problem may be .

Thank you @davesexcel for great comments and the LoopThroughFolder code has worked exactly the way i needed.

Thank you @jolivanes and @UncleStringer for barging in and helping .

Quote from davesexcel

Your original question and your sample workbooks do not match.

Here is the code that reflects on the sample workbook you have provided.

Your destination workbook is the workbook with the code and will be saved as a macro enabled workbook(.xlsm)

Change the folder address in the code.

There are two worksheets in the destination workbook. One named Columns and one named Rows.

Code

Sub LoopThroughFolder()

    Dim MyFile As String, Str As String, MyDir As String, wb As Workbook
    Dim rws As Long, rng1 As Range, rng2 As Range
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim Lstcl As Long, Lstrws As Long, cl As Long


    Set wb = ThisWorkbook
    Set sh1 = wb.Sheets("Columns")
    Set sh2 = wb.Sheets("Rows")

    'change the address to suite
    MyDir = "C:\Users\Dave\SkyDrive\Documents\New folder" & "\"
    MyFile = Dir(MyDir & "*.xlsx")    'change file extension
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        Workbooks.Open (MyFile)

        With Worksheets(1)
            rws = .Cells(Rows.Count, "G").End(xlUp).Row
            cl = .Cells(6, .Columns.Count).End(xlToLeft).Column
            Set rng1 = .Range(.Cells(5, 7), .Cells(rws, 7))
            Set rng2 = .Range(.Cells(6, 9), .Cells(6, cl))

            With sh1
                If .Cells(1, 1) = "" Then
                    Lstcl = 1
                Else
                    Lstcl = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
                End If
            End With

            With sh2
                If .Cells(1, 1) = "" Then
                    Lstrws = 1
                Else
                    Lstrws = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                End If
            End With

            rng1.Copy
            sh1.Cells(1, Lstcl).PasteSpecial xlPasteValues

            rng2.Copy
            sh2.Cells(Lstrws, 1).PasteSpecial xlPasteValues

            Application.CutCopyMode = False

        End With

        ActiveWorkbook.Close True
        MyFile = Dir()
    Loop

End Sub

Display More

Display More

I have attached the worksheets and highlighted what to be copied from source. Like this i have multiple files to be copied from but same format.

They can be copied in different sheets in same workbook destination.

Quote from Mumps

Is the first sheet in the first workbook blank?

No it isn't

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

I have attached the screenshots

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

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 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

Yes it does have xlsx extension

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

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)

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

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.

Thank you for reply, I haven't really hijacked anything or have an intension. My requirement is very similar so i was just refering the code. I'm new to this so I didn't know how it works . Sorry if it's an offense or to be termed as hijack. And I'll take the suggestion to start a POST.

Thanks a lot.

I tried other ways also for some reason it is not copying from all the worksheets or it is replacing the content so I see only last worksheet content , please help me here , I'm beginner

Hi,

When I was trying to use this in a folder with excel files named Image001, Image002 ... ect, some how only the last excel file information is getting copied, any help??

Quote from jolivanes

Here is an example
This should copy all 4th Columns From All Workbooks into Master providing that all, incl Workbook with code ("Master"?) are saved in one and the same Folder.
Change references, like Sheet names, as required.

Code

Sub Get_Columns()
    Dim sPath As String
    Dim sFil As String
    Dim owb As Workbook
    Dim twb As Workbook


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


    Set twb = ThisWorkbook
    sPath = ThisWorkbook.Path & "\"
    sFil = Dir(sPath & "*.xl*")


    Do While sFil <> "" And sFil <> twb.Name
        Set owb = Workbooks.Open(sPath & sFil)
        owb.Sheets("data").Columns(4).Copy twb.Sheets("report").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)    '<----- Change sheet names
        owb.Close False 'Close no save
        sFil = Dir
    Loop


        With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Display More