Question

I need to copy the excel sheets and make it into one consolidated excel workbook . After consolidating the worksheet , all files need to move to new folder called “Orginial”.
The folder should be be created where the file is located.

Problem is file will be selected by the user itself

I am using getfilename to get the path from the user

Steps invloving :

Step1 : for example : if user needs to select

C :\my documents\worksheet1.xls
C :\my documents\worksheet2.xls
C :\my documents\worksheet3.xls

step2 :file should be consolidated as worksheet1.xls and

step3: folder should be created in the c:\my documents\original

and all worksheet1, worksheet2,worksheet3 , should move into “original” folder

I have code for consolidting the excelsheets . But i dont know how to create a folder within the path .Please help me

Below is the code

Option Explicit

Sub copyma()

Dim wb(20) As Variant
Dim ws(20) As Variant
Dim lastrow As Variant
Dim lastr(20) As Variant
Dim nextrow As Variant
Dim tempwb As Variant
Dim tempws As Worksheet
Dim tempfile As Variant
Dim fnum As Variant
Dim ws1 As Worksheet
Dim m As Integer
Dim ffiles(20) As Variant
Dim nextlastrow As Variant
Dim lastcopyrow As Variant
Dim lastcopycol As Variant

Set ws1 = Worksheets("sheet1")

fnum = ws1.Range("b3").Value
'selecting temporary files

MsgBox " plz select the temp sheet"
tempfile = Application.GetOpenFilename

Set tempwb = Workbooks.Open(Filename:=tempfile)
Set tempws = tempwb.Worksheets("sheet1")
tempws.Cells.Clear

' sleecting number of files
For m = 1 To fnum
    MsgBox " Please Select " & m & "files"
    ffiles(m) = Application.GetOpenFilename
Next m

' opening the files and copying to the temp sheet
For m = 1 To fnum
    Set wb(m) = Workbooks.Open(Filename:=ffiles(m))
    Set ws(m) = wb(m).Worksheets("sheet")
    ws(m).AutoFilterMode = False
    ' finding the lastrow of the temp sheet
    lastrow = tempws.Range("A" & tempws.Rows.Count).End(xlUp).Row
    lastr(m) = ws(m).Range("A" & ws(m).Rows.Count).End(xlUp).Row
    MsgBox lastr(m)
    nextlastrow = lastrow + 1
    With ws(m)
        lastcopyrow = .Range("A" & .Rows.Count).End(xlUp).Row
        lastcopycol = ws(m).Cells(1, .Columns.Count).End(xlToLeft).Column
        '   lastcol = ws2.Cells(1, .Columns.Count).End(xlToLeft).Column
        If m = 1 Then
            .Range("A1", .Cells(lastcopyrow, lastcopycol)).Copy tempws.Cells(lastrow, 1)
        Else
            .Range("A2", .Cells(lastcopyrow, lastcopycol)).Copy tempws.Cells(nextlastrow, 1)
        End If
    End With
    wb(m).Close
Next m

tempws.Name = "sheet"
tempwb.Save

End Sub

Answer 1

'Get file path
Dim outfolder As String
outfolder = Mid(tmpfile, 1, InStrRev(tmpfile, "\")) & "original"
'Check if directory exists and create it if it does not
If Dir(outfolder) = "" Then
MkDir outfolder
End If