+ Reply to Thread
Results 1 to 2 of 2

For Each Next Assistance on Copying data from Multiple Worksheets

Hybrid View

  1. #1
    Valued Forum Contributor AlvaroSiza's Avatar
    Join Date
    09-19-2007
    Location
    Staffordshire
    MS-Off Ver
    2007
    Posts
    591

    For Each Next Assistance on Copying data from Multiple Worksheets

    I have worked through the search forum and actually incorporated a portion of RoyK's code from a like-kind thread, but can't seem to get it going. I appreciate the assistance.

    Ultimate Goal:
    - Click Event imports tabular data from 5 worksheets from a user-chosen source workbook and pastes to next available row + 1 (x1up + 1) in destination workbook.

    Here is my basic import code:
    Sub ImportData()
    '
    ' Import Macro
    '
    Dim strWorkbookName As String
    Dim strImportFileName As String
    pAbort = False
        
    'Get the current workbook name.
        strWorkbookName = ActiveWorkbook.Name
        
    ' Open Area 1 file for import.
        Filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),*.xls", Title:="Select the Metro Area Data File")
        If Filename = False Then
            MsgBox "No file was selected! Exiting..."
            Range("A1").Select
            pAbort = True
            Exit Sub
        End If
        
        Application.ScreenUpdating = False
       
        Workbooks.Open Filename
        strImportFileName = ActiveWorkbook.Name
        Range("A1:L62").Select
        Selection.Copy
        Windows(strWorkbookName).Activate
        Sheets("Metro").Visible = True
        Sheets("Metro").Select
        Range("C1").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Sheets("Metro").Visible = False
        Windows(strImportFileName).Activate
        Application.CutCopyMode = False
        ActiveWorkbook.Close
        
        Sheets("Master").Select
        Range("A1").Select
        Application.ScreenUpdating = True
        MsgBox ("Data compilation complete")
    
    End Sub
    And here is the code I pulled from RoyK in another thread that utilizes the for each next:
    Option Explicit
    
    Sub GetData()
        Dim fn
        Dim wbFrom As Workbook
        Dim ws     As Worksheet
        Dim rCopy  As Range
        Dim sSht   As String
        On Error Resume Next
        fn = Application.GetOpenFilename  'can add parameters. See help for details.
        If fn = False Then
            MsgBox "Nothing Chosen", vbCritical, "Select workbook"
            'now that you have the  name, you can open it
        Else: Workbooks.Open fn
            'set variable to source workbook
            Set wbFrom = ActiveWorkbook
            For Each ws In wbFrom.Worksheets
                With ws
                    sSht = .Name
                    'determine range to copy
                    Set rCopy = .Range(.Cells(2, 1), .Cells(.Rows.Count, 3).End(xlUp))
                End With
                'copy to relevant sheet in master wb
                If Not rCopy Is Nothing Then rCopy.Copy _
                   ThisWorkbook.Worksheets(sSht).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            Next ws
        End If
        On Error GoTo 0
        Set rCopy = Nothing
        Set wbFrom = Nothing
    End Sub
    I need help incorporating the for each next such that it pulls the range of A1:L62 from each of the 5 worksheets and pastes them either (I don't particularly have a preference)

    1. Into 1 worksheet - such that each next worksheet range is pasted below the previous + 1 row; or
    2. Into 5 worksheets

    Thanks!!!
    Last edited by AlvaroSiza; 12-06-2010 at 04:56 PM.

  2. #2
    Valued Forum Contributor AlvaroSiza's Avatar
    Join Date
    09-19-2007
    Location
    Staffordshire
    MS-Off Ver
    2007
    Posts
    591

    Re: For Each Next Assistance on Copying data from Multiple Worksheets

    Following up...

    RoyK's solution won the day. I did have to rename the worksheet name to its actual name
    ThisWorkbook.Worksheets("sSht").Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
    to
    ThisWorkbook.Worksheets("Data").Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
    Here is the code in total. Hope this helps someone else upon search. Thanks Roy!

    Option Explicit
    
    Sub GetData()
        Dim fn
        Dim wbFrom As Workbook
        Dim ws     As Worksheet
        Dim rCopy  As Range
        Dim sSht   As String
        On Error Resume Next
        fn = Application.GetOpenFilename  'can add parameters. See help for details.
        If fn = False Then
            MsgBox "Nothing Chosen", vbCritical, "Select workbook"
            'now that you have the  name, you can open it
        Else: Workbooks.Open fn
            'set variable to source workbook
            Set wbFrom = ActiveWorkbook
            For Each ws In wbFrom.Worksheets
                With ws
                    sSht = .Name
                    'determine range to copy
                    Set rCopy = .Range(.Cells(1, 12), .Cells(.Rows.Count, 1).End(xlUp))
                End With
                'copy to relevant sheet in master wb
                If Not rCopy Is Nothing Then rCopy.Copy _
                   ThisWorkbook.Worksheets("Data").Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
            Next ws
            ActiveWorkbook.Close
        End If
        On Error GoTo 0
        Set rCopy = Nothing
        Set wbFrom = Nothing
        
        ThisWorkbook.Sheets("Master").Select
        Range("A1").Select
        Application.ScreenUpdating = True
        MsgBox ("Data compilation complete")
    
    End Sub

+ 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