"Help needed!" in VBA Code for find the issue

[nkashyap3]

I have search much old thread but not getting the solution, I am able to find the error in my coding , Its look fine but in test run is not working,according to my step. below coding is some part of coding:-

1-I have files folder and there are many sub folders ( Name and number of count sub folder is not fixed). also path is not fixed every month will change the path
2- I have done the coding to get the sub folder(Dir) path list and folder name List on macro sheet also create the tab in macro file according the sub folder name. below is sample.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Path Dir of Sub folder[/TD]
[TD]folder Dir[/TD]
[TD]folder Name[/TD]
[/TR]
[TR]
[TD]C:\Users\nkashyap3\Desktop\New folder (2)\FMG\[/TD]
[TD]C:\Users\nkashyap3\Desktop\New folder (2)\[/TD]
[TD]FMG[/TD]
[/TR]
[TR]
[TD]C:\Users\nkashyap3\Desktop\New folder (2)\Travel\[/TD]
[TD]C:\Users\nkashyap3\Desktop\New folder (2)\[/TD]
[TD][TABLE="width: 45"]
<tbody>[TR]
[TD="width: 45"]Travel[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


3- now below coding is for to open each sub folder one by one and complied the excel files and paste in macro file according to sub folder name.
4- (My cell) is store the sub folder name list

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")


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
-----------------------------------------------
issue- Its running good in Do until loop for complied the all excel sheet in a folder and store the (Next i) statement "Stored the next folder path , but not store (Next MyCell) for

 

[DanteAmor]

I have search much old thread but not getting the solution, I am able to find the error in my coding , Its look fine but in test run is not working,according to my step. below coding is some part of coding:-

1-I have files folder and there are many sub folders ( Name and number of count sub folder is not fixed). also path is not fixed every month will change the path
2- I have done the coding to get the sub folder(Dir) path list and folder name List on macro sheet also create the tab in macro file according the sub folder name. below is sample.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Path Dir of Sub folder[/TD]
[TD]folder Dir[/TD]
[TD]folder Name[/TD]
[/TR]
[TR]
[TD]C:\Users\nkashyap3\Desktop\New folder (2)\FMG\[/TD]
[TD]C:\Users\nkashyap3\Desktop\New folder (2)\[/TD]
[TD]FMG[/TD]
[/TR]
[TR]
[TD]C:\Users\nkashyap3\Desktop\New folder (2)\Travel\[/TD]
[TD]C:\Users\nkashyap3\Desktop\New folder (2)\[/TD]
[TD][TABLE="width: 45"]
<tbody>[TR]
[TD="width: 45"]Travel[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


3- now below coding is for to open each sub folder one by one and complied the excel files and paste in macro file according to sub folder name.
4- (My cell) is store the sub folder name list


-----------------------------------------------
issue- Its running good in Do until loop for complied the all excel sheet in a folder and store the (Next i) statement "Stored the next folder path , but not store (Next MyCell) for

I think you do not need the for each Cell. You just have to put the value of column C in variable a.
Try and tell me.

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
[B][COLOR=#0000ff]        a = Cells(i, "C").Value[/COLOR][/B]
        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")
        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

 

[nkashyap3]

Its working fine now thank you so much !

 

[DanteAmor]

Its working fine now thank you so much !

I'm glad to help you. Thanks for the feedback.