Modifiy VBA code to paste to Next available Colunm

Moe Kadhom · Jun 8th 2015

Hi All
I was wondering if you can help me.

I have below VBA code that goes through multiple files and copy rang A1-C60 from all the sheets and paste them into a master workbook with one sheet. The macro is ran from that master workbook.

I need to run this macro every month, at the moment The data are pasted in the next available row. So my data are always in columns A to C with data running down.

I want the macro modified so the data are pasted in the next empty column. So the first time the macro is run, the data are pasted in columns A to C, the second time in D to F and so on........

could you help me?

Code

Option Explicit




' >>>>> Put the initial path where the files to be processed are stored here. _
  End with backslash
Const sInitialPath = "C:\MyPath\"




Sub GetData()
    Dim wbIn As Workbook, wbOut As Workbook
    Dim rIn As Range, rOut As Range
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim diaFolder As FileDialog
    Dim lCount As Long




    Set wbOut = ThisWorkbook
    ' Assuming masterWB has only one sheet
    Set wsOut = wbOut.Sheets(1)
    
        '   get file name for file to process
    MsgBox "Select all the files you want to process by using the Ctrl key and the mouse. "


    ' Open the file dialog to get the  files
    Set diaFolder = Application.FileDialog(msoFileDialogFilePicker)
    With diaFolder
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewList
        .InitialFileName = sInitialPath
        lCount = .Show
    End With
    If lCount = -1 Then
    ' for each selected file
    For lCount = 1 To diaFolder.SelectedItems.Count
        
        Set wbIn = Workbooks.Open(diaFolder.SelectedItems(lCount))


        'loop through all the sheets in the opened book
        For Each wsIn In wbIn.Sheets
            'set output range on the Mastersheet to last row
            Set rOut = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Offset(1, 0)
            'now copy the values accross to the Mastersheet
            With wsIn.Range("A1:C60")
                rOut.Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
        Next wsIn
        'close WB
        wbIn.Close savechanges:=False
    Next lCount
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True


    'Cleanup
    Set wbIn = Nothing
    Set wbOut = Nothing
    Set rIn = Nothing
    Set rOut = Nothing
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set diaFolder = Nothing
End Sub

Display More

**KjBox** · Jun 8th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Try replacing

Code

For Each wsIn In wbIn.Sheets
     'set output range on the Mastersheet to last row
    Set rOut = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Offset(1, 0)
     'now copy the values accross to the Mastersheet
    With wsIn.Range("A1:C60")
        rOut.Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With
Next wsIn

with

Code

For Each wsIn In wbIn.Sheets
    With wsOut
        'set output range on the Mastersheet to next available row and column
        lcol = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1
        If lcol = 2 Then lcol = 1
        'now copy the values accross to the Mastersheet
        .Cells(.Rows.Count, lcol).End(xlUp).Offset(1).Resize(60, 3).Value = _
        wsIn.Range("A1:C60").Value
    End With
Next wsIn

Written freehand so not tested!

Moe Kadhom · Jun 8th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
thanks for the reply. I replaced the code as per above but I'm getting " Variable not defined" and "lcol" highlighted.

this is probably a easy fix but im don't know much in VBA.

thanks for your help.

**KjBox** · Jun 9th 2015

Re: Modifiy VBA code to paste to Next available Colunm

You need to dimension the variable lCol.

Change

Code

Dim lCount As Long

to

Code

Dim lCount As Long, lCol as Long

Moe Kadhom · Jun 9th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
ok, its working now, but it is doing the exact same thing. Pasting the data below the previous data. What I want is to paste the data on the next available column. So the second time I run the macro it should paste the data in columns D to F, the third time, G to I and so on....

Also, I just noticed, It is not pasting all the data in columns A to C, midway through it paste them in columns C to E.

Thanks for your help.

My updated coded is:

Code

Option Explicit
 
 
 ' >>>>> Put the initial path where the files to be processed are stored here. _
End With backslash
Const sInitialPath = "C:\Users\mkadhom\Desktop\New folder\"
 
 
Sub GetData()
    Dim wbIn As Workbook, wbOut As Workbook
    Dim rIn As Range, rOut As Range
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim diaFolder As FileDialog
    Dim lCount As Long, lCol As Long
     
     
    Set wbOut = ThisWorkbook
     ' Assuming masterWB has only one sheet
    Set wsOut = wbOut.Sheets(1)
     
     '   get file name for file to process
    MsgBox "Select all the files you want to process by using the Ctrl key and the mouse. "
     
     ' Open the file dialog to get the  files
    Set diaFolder = Application.FileDialog(msoFileDialogFilePicker)
    With diaFolder
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewList
        .InitialFileName = sInitialPath
        lCount = .Show
    End With
    If lCount = -1 Then
         ' for each selected file
        For lCount = 1 To diaFolder.SelectedItems.Count
             
            Set wbIn = Workbooks.Open(diaFolder.SelectedItems(lCount))
             
             'loop through all the sheets in the opened book
            For Each wsIn In wbIn.Sheets
    With wsOut
         'set output range on the Mastersheet to next available row and column
        lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1
        If lCol = 2 Then lCol = 1
         'now copy the values accross to the Mastersheet
        .Cells(.Rows.Count, lCol).End(xlUp).Offset(1).Resize(60, 3).Value = _
        wsIn.Range("A1:C60").Value
    End With
Next wsIn
             'close WB
            wbIn.Close savechanges:=False
        Next lCount
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
     
     'Cleanup
    Set wbIn = Nothing
    Set wbOut = Nothing
    Set rIn = Nothing
    Set rOut = Nothing
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set diaFolder = Nothing
End Sub

Display More

**KjBox** · Jun 9th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Can you attach a sample of your workbook (the workbook that needs the data to be imported)

[h=2]How to Attach a Sample Workbook[/h] To attach a workbook:

Click 'Go Advanced' at the bottom right of the Reply Box.
In the new window click the Paper Clip Icon.
In the new window that pops up click 'Add Files'.
Click 'Select File' and browse to the required file.
Click 'Upload File'.
Click 'Done' when the selected file appears in the box at the bottom of the window.

The maximum file size allowed is 110kb, if your file is larger than this you can try zipping it to reduce the size. If still too large, or if your actual file contains sensitive data, then create a sample workbook with reduced amount of data or with sanitised data.
When creating a sample workbook it is essential that the structure of the actual workbook is retained.

If data has been sanitised, then the sanitised data must be of the same type as the original (text still text, numbers still numbers, dates still dates etc.).
The Layout of data on each sheet remains the same.
If actual data contains blank rows, columns or cells then include the same in the sample data.
If a cell contains a formula keep the formula in the sample, in other words do not create the sample file by pasting just values from the actual file.

[h=4]An accurate sample workbook will help us to help you.[/h]

Moe Kadhom · Jun 9th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
I have to export data from 17 files. attached are only two.

My master workbook. where I run my macro, is just a blank workbook for now.

If you could also modify the macro to only copy non-blank rows that would be great. I was going to do this using the macro recorder and added to the code, so don't worry about it if you don't have time.

Thanks

**KjBox** · Jun 9th 2015

Re: Modifiy VBA code to paste to Next available Colunm

The code you have now copies the range A1:C60 for each sheet in each workbook.

The files you attached have sheets with varying numbers of rows of data, some of which exceed 60 rows. Also row 1 in each sheet

Can you manually make a file that represents the master workbook as you want it to appear after importing data from the 2 workbooks you attached.

Then attach that sample master workbook.

Moe Kadhom · Jun 9th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
please see attached.

At this stage I just want the range A1:C60 from each sheet, regardless of how much data is in each sheet. this range may change in the future.

the attached file is what I expect when I run the macro for the two files I provided earlier. at the moment, if I run the macro the second time, it will paste the data below the previous data. What I want is to paste the data on the next available column.

Another thing I wanted to do is to enter the date when the macro has been run above every cell where the data is pasted. So the first time macro is run, the date will be in cell A1,B1 and C1, the second time it should be in Cell D1,E1,F1 third time in G1,H1,I1 and so on.

Thanks for taking the time and helping me with my problem. much appreciate your effort.

**KjBox** · Jun 9th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Try this

Code

Sub GetData()
    Dim wbIn As Workbook, wbOut As Workbook
    Dim rIn As Range, rOut As Range
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim diaFolder As FileDialog
    Dim lCount As Long, lCol As Long
    Dim x, y, i As Long, ii As Long, iii As Long, iv As Integer
    
    Set wbOut = ThisWorkbook
     ' Assuming masterWB has only one sheet
    Set wsOut = wbOut.Sheets(1)
     
     '   get file name for file to process
    MsgBox "Select all the files you want to process by using the Ctrl key and the mouse. "
     
     ' Open the file dialog to get the  files
    Set diaFolder = Application.FileDialog(msoFileDialogFilePicker)
    With diaFolder
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewList
        .InitialFileName = sInitialPath
        lCount = .Show
    End With
    If lCount <> -1 Then
        MsgBox "No file selected", , "File Picker"
        GoTo CleanUP
    Else
         ' for each selected file
        For lCount = 1 To diaFolder.SelectedItems.Count
            Set wbIn = Workbooks.Open(diaFolder.SelectedItems(lCount))
             'loop through all the sheets in the opened book
             Application.ScreenUpdating = False
            For Each wsIn In wbIn.Sheets
                x = wsIn.UsedRange '// Load sheet data into array x
                ReDim y(1 To UBound(x, 1) + 1, 1 To 3) '// Dimension array y according to ubound of array x
                For ii = 1 To 3 '// add Date to row 1
                    y(1, ii) = Date
                Next
                iii = 2: iv = 60
                If UBound(x, 1) < 60 Then iv = UBound(x, 1)
                For i = 1 To iv ' Loop through each element in array x 1st Dimension (equivqlent to max 60 rows of data)
                    If x(i, 1) <> "" Then '// Ignore blank rows
                        For ii = 1 To 3 '// Loop through first 3 columns of data
                            y(iii, ii) = x(i, ii) '// Load data into array y
                        Next
                        iii = iii + 1
                    End If
                Next
                With wsOut
                     'set output range on the Mastersheet to next available row and column
                    lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
                    If lCol = 2 Then lCol = 1
                     '// Place the contents of array y into the Mastersheet
                    .Cells(1, lCol).Resize(UBound(y, 1), 3).Value = y
                    .Cells.WrapText = False '// Remove any wrapped text
                    .Columns.AutoFit '// Adjust column widths to suit data
                End With
            Next wsIn
             'close WB
            wbIn.Close savechanges:=False
        Next lCount
    End If
CleanUP:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set wbIn = Nothing
    Set wbOut = Nothing
    Set rIn = Nothing
    Set rOut = Nothing
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set diaFolder = Nothing
End Sub

Display More

Moe Kadhom · Jun 9th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
Sorry, I should of showed more data in my master worksheet that I attached earlier. I don't want to paste range A1:C60 from each sheet in the next available colunms, rather I want all the data pasted below each other first, then the next time macro is run, it paste all the data starting in the first cell in the next empty column.

I have attached my master sheet showing a sample of what I want if the macro was run three times in three different days.

Thanks

**KjBox** · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

OK I think I have got what you mean now, try this

Code

Option Explicit
 ' >>>>> Put the initial path where the files to be processed are stored here. _
End With backslash
Const sInitialPath = "C:\Users\mkadhom\Desktop\New folder\"
 
Sub GetData()
    Dim wbIn As Workbook, wbOut As Workbook
    Dim rIn As Range, rOut As Range
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim diaFolder As FileDialog
    Dim lCount As Long, lCol As Long, lRow As Long
    Dim x, y, i As Long, ii As Long, iii As Long, iv As Integer
    
    Set wbOut = ThisWorkbook
     ' Assuming masterWB has only one sheet
    Set wsOut = wbOut.Sheets(1)
     
     '   get file name for file to process
    MsgBox "Select all the files you want to process by using the Ctrl key and the mouse. "
     
     ' Open the file dialog to get the  files
    Set diaFolder = Application.FileDialog(msoFileDialogFilePicker)
    With diaFolder
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewList
        .InitialFileName = sInitialPath
        lCount = .Show
    End With
    If lCount <> -1 Then
        MsgBox "No file selected", , "File Picker"
        GoTo CleanUP
    Else
         '// Get next available column and add date to 3 columns
        With wsOut
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
            If lCol = 2 Then lCol = 1
            With .Cells(1, lCol).Resize(, 3)
                .Value = Date
                .Columns.AutoFit
            End With
        End With
         ' for each selected file
        For lCount = 1 To diaFolder.SelectedItems.Count
            Set wbIn = Workbooks.Open(diaFolder.SelectedItems(lCount))
             'loop through all the sheets in the opened book
             Application.ScreenUpdating = False
            For Each wsIn In wbIn.Sheets
                x = wsIn.UsedRange '// Load sheet data into array x
                ReDim y(1 To UBound(x, 1), 1 To 3) '// Dimension array y according to ubound of array x
                iii = 1: iv = 60
                If UBound(x, 1) < 60 Then iv = UBound(x, 1)
                For i = 1 To iv ' Loop through each element in array x 1st Dimension (equivqlent to max 60 rows of data)
                    If x(i, 1) <> "" Then '// Ignore blank rows
                        For ii = 1 To 3 '// Loop through first 3 columns of data
                            y(iii, ii) = x(i, ii) '// Load data into array y
                        Next
                        iii = iii + 1
                    End If
                Next
                With wsOut
                     'set output range on the Mastersheet to next available row
                    lRow = .Cells(.Rows.Count, lCol).End(xlUp).Row + 1
                     '// Place the contents of array y into the Mastersheet
                    .Cells(lRow, lCol).Resize(UBound(y, 1), 3).Value = y
                    '.Columns.AutoFit '// Adjust column widths to suit data (uncomment this line if you want column widths to adjust)
                End With
            Next wsIn
             'close WB
            wbIn.Close savechanges:=False
        Next lCount
    End If
CleanUP:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set wbIn = Nothing
    Set wbOut = Nothing
    Set rIn = Nothing
    Set rOut = Nothing
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set diaFolder = Nothing
    
End Sub

Display More

Moe Kadhom · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ,
That is it. You are awesome. Cant thank you enough.

If I want to change the range that is copied from the sheets, which lines of the code do I need to change? I may need to do this in future.

Thanks

**KjBox** · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

You're welcome.

For a different range to be copied change the 60 in these 2 lines of code to the last row that you need to be copied.

Code

iii = 1: iv = 60
If UBound(x, 1) < 60 Then iv = UBound(x, 1)

If you need the copy range to start at a row other than Row 1 then change the 1 in this line of code to the start row required

Code

For i = 1 To iv

Moe Kadhom · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Great. Thanks for that.

Just another thing, but if you are busy don't worry about it. You have done a lot already.

Could you modify the macro to only copy the rang from selected sheets? I want the range copied from Sheets : "Retail, "Fleet", "Warehouse Solutions", "Service" and "Rentals".

All the files will have the exact sheet names.

Thanks for your help

**KjBox** · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

I can do that for you.

I see that in each of those sheets the last 4 rows are just an explanation of what the conditional formatting means. There seems little point in copying those rows to the Master, so do you want me to make the code exclude them?

Moe Kadhom · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
yes that would be awesome. I actually do not require all the information. I just didn't want to make it harder for someone to help me.

in fact, if you can only copy the cells that I want, that would be the ultimate help.

Basically I just want the values in yellow cells in the two work books I send to you earlier.( all my files are the exact same format and the yellow cells are exactly in the same place across all workbooks) Please see attached master workbook to see what the final result suppose to look like. as advised earlier, only yellow cells from sheets :"Retail, "Fleet", "Warehouse Solutions", "Service" and "Rentals".

Don't worry about the description in column A because they are always the same. I just want the corresponding value from each sheet.

Also for my formulas to work can you please add letter "B" right after the date above the second column. ( see my attached file)

The name in cell B3 in sheet 2 needs to be Pasted below the date. ( see my attached file).

If you can do this for me, you are doing me a huge favour. to be honest, I didn't think anybody can be this helpful and that's why I didn't ask for everything at once.

Much appreciate your help.

**KjBox** · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Are the yellow cells coloured by conditional formatting or manually coloured? I cannot tell which because the sheets are password protected and need to know either the condition that sets the colour or, if not conditionally formatted, the RGB value for the colour.

Can you either post the password here or PM it to me.

Thanks.

Moe Kadhom · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
I don't know the password at the moment, Ill get it for you tomorrow. however, the yellow cell is not conditionally formatted. The colour is the pre-set cell style "Note".

RGB is
Red 255
Green 255
Blue 204

Thanks

Moe Kadhom · Jun 10th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
Please note, the values next to the yellow cells which will be under the heading " Budget" will also need to be copied as per my master worksheet I attached earlier.

Thanks

Modifiy VBA code to paste to Next available Colunm

Participate now!

Share