For Each MyCell In MyRange is not working in second time

[nkashyap3]

Hi Friends, I need help in vba. I have create the complied the excel files form the folder in one tab,I have done the coding the get the sub folder name list in one column , I want the coding create the tab name according the list , my coding is working fine when its run first time but after comes on Next I (storing the next path of sub folder) not coming on Next Mycell( Store the secound sub folder name.

Sub kkkk()


Dim Fpath As String


Dim Fname As String


Dim Wkb As Workbook


Dim ws As Worksheet
Dim MyCell As Range
    Dim MyRange As Range






Sheets("path").Select




Set MyRange = Sheets("path").Range("C3")
    
                     Set MyRange = Range(MyRange, MyRange.End(xlDown))




LRow = Cells(Rows.Count, 1).End(xlUp).Row


Lcol = Cells(1, Columns.Count).End(xlToLeft).Column


  














For Each MyCell In MyRange
     
     a = MyCell
     
For I = 3 To LRow


Fpath = Cells(I, 1).Value


Fname = Dir(Fpath & "*.xls*")


Sheets(a).Activate
Sheets(a).Cells(1).Resize(1, 13).Value = Array("DeptID", "DeptID Description", "Month Ending", "Date Run", "Project", "Account", "Account Description", "Business Unit", "Journal ID", "EffDate", "Source", "Description", "Amount")


'Windows("Master.xlsx").Activate
Do Until Fname = ""


         Set wb = Workbooks.Open(Filename:=Fpath & Fname)
                  
      ActiveSheet.Cells(2, 1).EntireRow.Select
      
      
      
    
'Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
      
      Windows("test.xlsm").Activate
   'Workbooks("Template.xls").Activate


     Sheets(a).Activate
      
 NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Cells(NextRow, 1).Select


 
      ActiveSheet.Paste


 
'
'
'        'For Each ws In Wkb.Worksheets
'            ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'        'Next ws
'        Wkb.Close False


 Workbooks(Fname).Close
 Application.DisplayAlerts = False
        Fname = Dir()
        
         
    Loop
    
    'Application.EnableEvents = True
    'Application.ScreenUpdating = True
     
     Sheets("path").Select
     
     Next I
     
     
           Next MyCell
















End Sub

 

[gallen]

Re: For Each MyCell In MyRange is not working in secound time

Hello and welcome. You stand a better chance of reply if you read the forum guidelines and include code tags around your code.

Sub kkkk()
    Dim Fpath As String
    Dim Fname As String
    Dim Wkb As Workbook
    Dim ws As Worksheet
    Dim MyCell As Range
    Dim MyRange As Range
    
    Sheets("path").Select


    Set MyRange = Sheets("path").Range("C3")
    
    Set MyRange = Range(MyRange, MyRange.End(xlDown));


    LRow = Cells(Rows.Count, 1).End(xlUp).Row


    Lcol = Cells(1, Columns.Count).End(xlToLeft).Column


    For Each MyCell In MyRange
    
        a = MyCell
        
        For I = 3 To LRow


            Fpath = Cells(I, 1).Value
    
            Fname = Dir(Fpath & "*.xls*")
    
            Sheets(a).Activate
            Sheets(a).Cells(1).Resize(1, 13).Value = Array("DeptID", "DeptID Description", "Month Ending", "Date Run", "Project", "Account", "Account Description", "Business Unit", "Journal ID", "EffDate", "Source", "Description", "Amount")
    
            'Windows("Master.xlsx").Activate
            Do Until Fname = ""
    
                Set wb = Workbooks.Open(Filename:=Fpath & Fname)
                
                ActiveSheet.Cells(2, 1).EntireRow.Select
        
                'Range(Selection, Selection.End(xlToRight)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
            
                Windows("test.xlsm").Activate
                
                Sheets(a).Activate
                
                NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
                Cells(NextRow, 1).Select
                
                ActiveSheet.Paste
        
                Workbooks(Fname).Close
                Application.DisplayAlerts = False
                Fname = Dir()
            Loop


            Sheets("path").Select
        
        Next I
        
    Next MyCell
    
End Sub

 

[gallen]

Re: For Each MyCell In MyRange is not working in secound time

I Struggled to read your code, I'd comment each line, stating exactly what you want it achieve in plain english then post that as formatted above