+ Reply to Thread
Results 1 to 1 of 1

Macro to import data from different work book and sort

  1. #1
    Registered User
    Join Date
    08-11-2012
    Location
    London
    MS-Off Ver
    Excel 2007
    Posts
    0

    Macro to import data from different work book and sort

    Hi

    Please can some one help me with the below Macro.
    I am trying to collate data from different workbook file into one master workbook. I came across the following Macro but after making my changes to it I still find it does not work.

    I am importing the data from a folder which is named Time Sheets 2012-2013.
    The criteria value is Employee Number in Column A. If no employee number is <1 Ignore Row.
    We pay salaries every 2 weeks, therefore I need to compile each week data separately on one Worksheet and sorted it in Employee Number order.
    Inside this folder there is a folder for each week of the year starting from Week 1 through to Week 53.
    Within each weekly folder is 11 different excel workbook and the sheets names are F0-F10.
    I wish to import specific data from each worksheet to the New Workbook.



    Sub Combine_Workbooks_Select_Files()
    Dim MyPath As String
    Dim SourceRcount As Long, Fnum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim SaveDriveDir As String
    Dim FName As Variant

    With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    SaveDriveDir = CurDir
    ChDirNet "C:\"

    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
    MultiSelect:=True)
    If IsArray(FName) Then
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets()
    rnum = 1
    For Fnum = LBound(FName) To UBound(FName)
    Set mybook = Nothing
    On Error Resume Next
    Set mybook = Workbooks.Open(FName(Fnum))
    On Error GoTo 0
    If Not mybook Is Nothing Then
    On Error Resume Next
    With mybook.Worksheets(F0)
    Set sourceRange = .Range("A10:A100")
    End With
    If Err.Number > 0 Then
    Err.Clear
    Set sourceRange = Nothing
    Else
    If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
    Set sourceRange = Nothing
    End If
    End If
    On Error GoTo 0

    If Not sourceRange Is Nothing Then

    SourceRcount = sourceRange.Rows.Count

    If rnum + SourceRcount >= BaseWks.Rows.Count Then
    MsgBox "Not enough rows in the sheet. "
    BaseWks.Columns.AutoFit
    mybook.Close savechanges:=False
    GoTo ExitTheSub
    Else
    Set destrange = BaseWks.Range("A" & rnum)
    With sourceRange
    Set destrange = destrange. _
    Resize(.Rows.Count, .Columns.Count)
    End With
    destrange.Value = sourceRange.Value

    rnum = rnum + SourceRcount
    End If
    End If
    mybook.Close savechanges:=False
    End If
    Next Fnum
    BaseWks.Columns.AutoFit
    End If
    ExitTheSub:
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = CalcMode
    End With
    ChDirNet SaveDriveDir
    End Sub




    Can anyone help me?

    Jerry
    Last edited by jerry499; 08-19-2012 at 05:57 AM.

+ 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