+ Reply to Thread
Results 1 to 15 of 15

Need to copy values from all files in folder from specific worksheet

Hybrid View

  1. #1
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Need to copy values from all files in folder from specific worksheet

    Trying to create a macro that will copy data from a specific range (A3:H8) in a specific sheet(Assay Chart) from closed files in the same folder. The files are created off a template where just the data in certain cells change. The data needs to be pasted as values as I am planning on graphing the data on one graph once copied over to my new sheet. If more info is needed let me know. I would like to have the data stacked. I have tried to build one on my own but I am new to creating code and I have not had much success.
    Last edited by jh51745; 05-30-2013 at 01:07 PM.

  2. #2
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    I found this code that is close to what I need after a couple modifications. But I need it to add the values vertically and not horizontal with the file name preferably in column next to the data while keeping source formatting. Also, don't need to create new workbook and sheet, need to keep in current one. Any ideas?
    Option Explicit
    Sub MergeHorizontally()
        Dim MyPath As String, FilesInPath As String
        Dim MyFiles() As String
        Dim SourceCcount As Long, FNum As Long
        Dim mybook As Workbook, BaseWks As Worksheet
        Dim sourceRange As Range, destrange As Range
        Dim Cnum As Long, CalcMode As Long
    
        ' Change this to the path\folder location of the files.
        MyPath = "C:\Trending Data\"
    
        ' Add a slash at the end of path if needed.
        If Right(MyPath, 1) <> "\" Then
            MyPath = MyPath & "\"
        End If
    
        ' If there are no Excel files in the folder, exit.
        FilesInPath = Dir(MyPath & "*.xls*")
        If FilesInPath = "" Then
            MsgBox "No files found"
            Exit Sub
        End If
    
        ' Fill in the myFiles array with the list of Excel files in
        ' the search folder.
        FNum = 0
        Do While FilesInPath <> ""
            FNum = FNum + 1
            ReDim Preserve MyFiles(1 To FNum)
            MyFiles(FNum) = FilesInPath
            FilesInPath = Dir()
        Loop
    
        ' Change the application properties.
        With Application
            CalcMode = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        ' Add a new workbook with one sheet.
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        Cnum = 1
    
        ' Loop through all of the files in the myFiles array.
        If FNum > 0 Then
            For FNum = LBound(MyFiles) To UBound(MyFiles)
                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
                On Error GoTo 0
    
                If Not mybook Is Nothing Then
    
                    On Error Resume Next
                    Set sourceRange = mybook.Worksheets(3).Range("b3:h8")
    
                    If Err.Number > 0 Then
                        Err.Clear
                        Set sourceRange = Nothing
                    Else
                        ' If the source range uses all of the rows
                        ' then skip this file.
                        If sourceRange.Rows.Count >= BaseWks.Rows.Count Then
                            Set sourceRange = Nothing
                        End If
                    End If
                    On Error GoTo 0
    
                    If Not sourceRange Is Nothing Then
    
                        SourceCcount = sourceRange.Columns.Count
    
                        If Cnum + SourceCcount >= BaseWks.Columns.Count Then
                            MsgBox "There are not enough columns in the sheet."
                            BaseWks.Columns.AutoFit
                            mybook.Close savechanges:=False
                            GoTo ExitTheSub
                        Else
    
                            ' Copy the file name in the first row.
                            With sourceRange
                                BaseWks.Cells(1, Cnum). _
                                        Resize(, .Columns.Count).Value = MyFiles(FNum)
                            End With
    
                            ' Set the destination range.
                            Set destrange = BaseWks.Cells(3, Cnum)
    
                            ' Copy the values from the source range
                            ' to the destination range.
                            With sourceRange
                                Set destrange = destrange. _
                                                Resize(.Rows.Count, .Columns.Count)
                            End With
                            destrange.Value = sourceRange.Value
    
                            Cnum = Cnum + SourceCcount
                        End If
                    End If
                    mybook.Close savechanges:=False
                End If
    
            Next FNum
            BaseWks.Columns.AutoFit
        End If
    
    ExitTheSub:
        'Restore ScreenUpdating, Calculation and EnableEvents
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = CalcMode
        End With
    
    End Sub
    Last edited by jh51745; 05-30-2013 at 02:26 PM.

  3. #3
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    Still need help to modify the code I have to go from columns to rows and to paste the values from the formula.

  4. #4
    Forum Expert
    Join Date
    03-28-2012
    Location
    TBA
    MS-Off Ver
    Office 365
    Posts
    12,454

    Re: Need to copy values from all files in folder from specific worksheet

    Try attached.
    I am making few assumptions.
    You want to copy the file name in column A and the rest of the data in column B.
    Your sheet index number is 3.
    You can use sheet name instead if you want to use sheet name.
     With sourceBook.Worksheets("Assay Chart")
    You have a header in row 1 in the master sheet and all data are copied in to this sheet
    Attached Files Attached Files

  5. #5
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    Nothing was imported, just says please wait while files are being imported. Is this suppose to be a long process?

  6. #6
    Forum Expert
    Join Date
    03-28-2012
    Location
    TBA
    MS-Off Ver
    Office 365
    Posts
    12,454

    Re: Need to copy values from all files in folder from specific worksheet

    Could you please step over the code using F8 and see what error you are getting? Do you have files on your folder? Does the code open any worksheet?

  7. #7
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    When I step through it opens all the files and looks like it copies but nothing is pasted into master.

  8. #8
    Forum Expert
    Join Date
    03-28-2012
    Location
    TBA
    MS-Off Ver
    Office 365
    Posts
    12,454

    Re: Need to copy values from all files in folder from specific worksheet

    Do you have a header in master sheet? If you do not have, please put one in row 1

  9. #9
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    That did it. Thanks. Any idea on how to switch the columns after I have a chart inserted? First row should be category or x-axis.

  10. #10
    Forum Expert
    Join Date
    03-28-2012
    Location
    TBA
    MS-Off Ver
    Office 365
    Posts
    12,454

    Re: Need to copy values from all files in folder from specific worksheet

    Any idea on how to switch the columns after I have a chart inserted? First row should be category or x-axis?
    Not sure I understand your request.
    If its is a chart issue, I do not know. If you want to transpose ,i.e. change rows to columns, it is possible.

  11. #11
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    It is a chart issue. For some reason it is not setting my header as my x-axis/category after I have my chart created.

  12. #12
    Forum Expert
    Join Date
    03-28-2012
    Location
    TBA
    MS-Off Ver
    Office 365
    Posts
    12,454

    Re: Need to copy values from all files in folder from specific worksheet

    I suggest you should post it on "charting and pivot table section" of this forum and you will get a speed response.

  13. #13
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    ok Thanks I will mark this portion of the problem as solved.

  14. #14
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    Forgot I need to open all files in sub folders as well. I have looked for ideas but not much luck.
    
    'Initialise the following varibales to the first *.xls file in the designated folder
         FolderPath = "C:\Documents and Settings\Trending Data\" 'Change to your own path
         If Right(FolderPath, 1) <> "\" Then ' Add a slash at the end of the path if needed.
            FolderPath = FolderPath & "\"
         End If
         Filename = Dir(FolderPath & "*.xls") 'Excel 2003 file types to import
       
        Do Until Filename = ""
        
            Set sourceBook = Workbooks.Open(FolderPath & Filename)
            
             With sourceBook.Worksheets(3)
                      LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                      NR = shtMy.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
                      .Range("A3:H4").Copy
                       shtMy.Range("B" & NR).PasteSpecial xlValues
                       shtMy.Range("A" & NR).Resize(LR - 5) = Filename
                        Application.DisplayAlerts = False
                        sourceBook.Close SaveChanges:=False
                        Application.DisplayAlerts = True
                     
            End With
          
            Filename = Dir()
        
        Loop
       
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .AskToUpdateLinks = True
            .Calculation = CalcMode
        End With
    Last edited by jh51745; 06-03-2013 at 01:29 PM.

  15. #15
    Registered User
    Join Date
    05-28-2013
    Location
    US
    MS-Off Ver
    Excel 2010
    Posts
    73

    Re: Need to copy values from all files in folder from specific worksheet

    edited to include current code for file selection.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1