VBA Macro Code

elake

New Member
Joined
Jul 27, 2020
Messages
3
Office Version
  1. 365
  2. 2010
  3. 2007
Platform
  1. Windows
Hi,

I am in need of help. I have been trying to manipulate different codes i found with no success yet. I need a code that will go through a folder and copy data from different workbooks into a single sheet of a separate workbook.
The destination workbook/sheet is Book1 Sheet1. The Source workbooks and sheets are all indivdually labeled with dates and times as well as serial numbers for the units. The first column in this sheet is my header columns for the data. The data i need to copy is in cells C6, C7,C10, C11, C12, C16, C21, C28, C29, C30, C31, C32, C33, C34, C35, C36, C37, C38, C39, and C41. I need these items from each workbook to paste into the destination sheet in a single column, starting in column 'B' then go to the next column when pasting from the next workbook. Any help can be appreciated.
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
I've amended the code from the link in my last post, so that it will post data from each file in a new column, rather than a new row. In every other respect, it is as described in that link.

Remember that:
  • The folder containing the source files can't contain any other file. The conversion file (the one containing this code) and the destination file must be in a different folder.
  • The source files should be single worksheet files - or at least be saved with the worksheet that you need as the active one.
  • The conversion file (containing the macro) should have headings in column A and source file cell references in column B. These must start in row 1, and there should be no blank rows. So put C6 in cell B1, C7 in cell B2, C10 in cell B3, and so on.
  • Data will be brought across as values (to avoid any risk of creating formula links between spreadsheets) - this may mean that you'll need to re-format amounts / dates, etc.
  • The screen won't update while the macro is running - this is to speed up the process. However progress will be reported in the status bar.
  • The macro shouldn't affect your source files as they are opened as "read only". However, to be safe, I would suggest taking a copy of the folder containing the source files, and run it on that.
Code:
Sub ConvertFiles()


Dim TempWb As Workbook
Dim SummWb As Workbook
Dim SceWb As Workbook


'Get folder containing files
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    On Error Resume Next
    myFolderName = .SelectedItems(1)
    Err.Clear
    On Error GoTo 0
End With
If Right(myFolderName, 1) <> "\" Then myFolderName = myFolderName & "\"


'Settings
Application.ScreenUpdating = False
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Set TempWb = ActiveWorkbook
Set SummWb = Workbooks.Add


'Get name to save output file
myFileName = Application.GetSaveAsFilename("Combined Data.xlsx", "Excel Workbook (*.xlsx), *.xlsx", , "Save combined file as")
SummWb.SaveAs (myFileName)


'Count number of fields and copy across headers
DataRows = TempWb.ActiveSheet.Range("A1").End(xlDown).Row
For n = 1 To DataRows
    SummWb.ActiveSheet.Cells(n, 1).Value = TempWb.ActiveSheet.Cells(n, 1).Value
Next


'Get source files and append to output file
myFileNum = 1
mySceFileName = Dir(myFolderName & "*.*")
Do While mySceFileName <> "" 'Stop once all files found
    Application.StatusBar = "Processing: " & mySceFileName
    Set SceWb = Workbooks.Open(myFolderName & mySceFileName) 'Open file found
    For n = 1 To DataRows
        SummWb.ActiveSheet.Cells(n, myFileNum + 1).Value = SceWb.ActiveSheet.Range(TempWb.ActiveSheet.Cells(2, n).Value).Value
    Next
    SceWb.Close (False) 'Close Workbook
    myFileNum = myFileNum + 1
    mySceFileName = Dir
Loop


'Settings and save output file
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
SummWb.Activate
SummWb.Save
Application.ScreenUpdating = True


End Sub

Hope this helps!
 
Upvote 0
Thanks for the quick response. When I run the code i receive: "Run-time error '1004': Application-defined or object-defined error. And the debug option takes me to the highlighted line in the picture below.


1595940427134.png
 
Upvote 0
Sorry - I can see that I forgot to switch the row and column references on the second half of that line.

It was ...Cells(2, n)... but should have been ...Cells(n, 2).... This is the bit of code which determines the cell to look at in the source workbook - and rather than picking up the first reference from B1 in the conversion workbook, it was trying to pick it up in A2. The value in A2 would have been the header description for the second item that you're bringing across, rather than a valid cell reference.

Please change the highlighted row to:
Code:
       SummWb.ActiveSheet.Cells(n, myFileNum + 1).Value = SceWb.ActiveSheet.Range(TempWb.ActiveSheet.Cells(n, 2).Value).Value

Hope this now works.
 
Upvote 0
Tested it out with the corrected line and it worked perfectly the first time. Thanks again Trevor for all of your help.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,541
Latest member
iparraguirre89

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top