Loop Diffrent Excel Sheet and paste data in Master Sheet in lastrow

[ajkua]

Hi Everyone,

I need some code that will Copy Diffrent Excel Files data and paste into Master file

Simply stated, the loop code will open every file in a single directory and, one at a time, will copy/paste to the Master.

What I need is the loop code to go through all of the Excel files Remove Filter Unhide All Cell and stop when the process has been performed on the last file.

Been searching the web, but not able to find suitable code I need the VBA Code Of this

I'm running Excel 2007,
Thanks in Advance
Ajay

---

 

[jeffcrtra]

Dude,
I have a Macro that does exactly wht you're asking, but I do not have the time to remove the personalized settings since I'm at work right now. But... this will give a good starting point.
I believe you would need to change the 'Make_me_Work' Function.

Sub LoopThroughFiles()
Application.ScreenUpdating = False
    Dim StrFile As String
    Set TB = ThisWorkbook
    On Error GoTo GetOut
    Call clear
    StrFile = Dir(ThisWorkbook.Path & "\Raw Data\" & "filename*")
    Do While Len(StrFile) > 0
        Debug.Print StrFile
        StrFile = Dir
        Workbooks.Open Filename:=ThisWorkbook.Path & "\Raw Data\" & StrFile
        Make_me_Work
    Loop
GetOut:
Application.ScreenUpdating = True
End Sub
' ***********************************
Function Make_me_Work()
  Dim FindString As String
  Dim MyDate
  Set wb2 = ActiveWorkbook
    Dim Rng As Range
    FindString = "Agent ID"
    If Trim(FindString) <> "" Then
        With Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                'Application.Goto Rng, True
                Rng.Offset(1, 0).Select
                Let MyDate = ActiveCell.Offset(-3, 1).Value
                ActiveSheet.Range(ActiveCell, ActiveCell.Offset(0, 13).End(xlDown)).Select
                Selection.Copy
                TB.Activate
                Sheets("Top Agent").Activate
                Range("C69").End(xlUp).Offset(1, 0).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                     Do Until IsEmpty(ActiveCell)
                       ActiveCell.Offset(0, -1).Value = MyDate
                       ActiveCell.Offset(1, 0).Select
                    Loop
                    
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
   wb2.Activate
   ActiveWorkbook.Close
End Function