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