Kind Support on my Issue.

[mike8791]

Hello Folks,

I have tons of folder in each folder i have 12 excel files Named "1,2,3,4,5,6,7,8,9,10,11,12". I run the code every time and i have been asked to input the three tasks *. I'm looking to slightly modify the code in such:
it just asks for
1- folder location " the one containing amount of 12 ".xl" files.
my code ask to input three tasks*:
1- Task One: the file location i want to open.
2- Task Two: Range Selection on selected workbook to preform the code.
3- Task Three: The name of column i want to paste my results to.

"Essentially no need to modify the functionality of the code but only the three tasks onto one task. it only Just ask for the folder location" The one containing the 12 exel files" then the code should understand file name 1 end-results paste it in destination column A ...... etc ".


Note my destination file is fine with me, i only need to open the 12 xl files automatically and paste the results of each file in the destination file as if
column "A" Data from .xl file 1
column "B" Data from .xl file 2
column "C" Data from .xl file 3
column "D" Data from .xl file 4
column "E" Data from .xl file 5
column "F" Data from .xl file 6
column "G" Data from .xl file 7
column "H" Data from .xl file 8
column "I" Data from .xl file 9
column "J" Data from .xl file 10
column "K" Data from .xl file 11
column "L" Data from .xl file 12

Here is the code:

Sub CopyRange()
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, srcWB As Workbook, desWS As Worksheet, cnt As Long
    Dim copyRng As Range, desCol As String, i As Long, x As Long
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title = "Please Select an Excel File"                 ' Here i want it to ask once only
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set srcWB = Workbooks.Open(FileName)
    Set copyRng = Application.Range("$D$3:$N$15")   ' keep this
    Application.ScreenUpdating = False
    cnt = copyRng.Columns.Count
    desCol = InputBox("Enter the column letter where you want to paste.")  ' the code should know if file name "1" paste onto column "A"
    If desCol = "" Then Exit Sub
    For i = 1 To copyRng.Rows.Count
        With desWS
            If WorksheetFunction.CountA(.UsedRange) = 0 Then
                .Cells(2, desCol).Resize(cnt) = WorksheetFunction.Transpose(copyRng.Cells(i, 1).Resize(, cnt))
            Else
                .Cells(.Rows.Count, desCol).End(xlUp).Offset(1).Resize(cnt) = WorksheetFunction.Transpose(copyRng.Cells(i, 1).Resize(, cnt))
            End If
        End With
    Next i
    ActiveWorkbook.Close False
    Application.ScreenUpdating = True
End Sub