Copy non adjacent data cells into one workbook

Question

this is the code that i am currently using right now, but its not enough to meet my objectives and i am stuck on how to continue....

So this code will copy the specified data from many other excel workbook in the form of xlsx into a main excel workbook and before that it will scan through the folder which contains all the different data files and the main file(all files supposed to be transfered here in a table form) e.g. Test3.xlsx,Test4.xlsx,Test.xlxs and Main.xlsm in the folder of ScanFiles. so everytime a new files comes into the folder, it will automatically update the main workbook by opening the data workbooks then copy the required data and paste it on the main workbook upon clicking a button.

Sub ScanFiles()
Dim myFile As String, path As String
Dim erow As Long, col As Long

path = "c:\Scanfiles\"
myFile = Dir(path & "*.xlsx")

Application.ScreenUpdating = False

Do While myFile <> ""
Workbooks.Open (path & myFile)
Windows(myFile).Activate

Set copyrange = Sheets("sheet1").Range("A18,B18,C18,D18,A19,B19,C19,D19")

Windows("master-wbk.xlsm").Activate

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

col = 1
For Each cel In copyrange
cel.Copy

Cells(erow, col).PasteSpecial xlPasteValues

col = col + 1

Next

Windows(myFile).Close savechanges:=False
myFile = Dir()
Loop
Range("A:E").EntireColumn.AutoFit

Application.ScreenUpdating = True

End Sub

Objectives: 1st:orignal type of file is in "file" not xlsx, so hope to find a way to open the file in xlsx format automatically before start of copying data. 2nd: requires 3 types of specified data e.g. name,surname(both of them are in fixed position always in A18 to D18 and A19 to D19 , 3rd one is to find the date, however the date is almost always in different positions in the data sheet, so i hope to add on a part to the code that makes it search for something like "ended 20190808" it will always start with ended but will always be in diff rows or even columns. i also need to arrange the data according to the date from newest(top) to oldest(bottom) and state the month of the date in words instead of numbers e.g. june Deeply Appreciate any form of help but if possible the small section of code that can add on to my coding will make it a lot easier because im tasked to do this in a very limited amount of time Thank you!!!

Answer 1

Here's some code that does similar things to what you describe. The animated .gif shows it working by stepping through the code. First the 2 data (.xlsx) files are shown so you have an idea of their content. Each is located in the same folder as the main workbook and has data in column A. Then as we step through the code each file is opened, its data manipulated (row 3 is deleted) and transferred into adjacent columns of the main workbook. The code is not limited to .xlsx files and will work with text files as well, as long as ext is defined.

Hopefully, once you understand how this works you can modify it to apply it to your case.

Option Explicit
Sub CombineFiles()
Dim theDir As String, numFiles As Integer
Dim sh As Worksheet, wk As Workbook, newSheet As Worksheet
Dim newColumn As Range, r As Range, s As String
Const ext = ".xlsx"
    Err.Clear
    theDir = ThisWorkbook.Path
    Set newSheet = ThisWorkbook.Sheets.Add
    newSheet.Name = "Combined"
    Set newColumn = newSheet.Range("A1")
    'Loop through all files in directory
    s = Dir(theDir & "\*" & ext)
    While s <> ""
        numFiles = numFiles + 1
        On Error Resume Next
        Set wk = Workbooks.Open(theDir & "\" & s)
        Set sh = ActiveSheet
        sh.Rows(3).Delete Shift:=xlUp
        Set r = Range("A1")
        Range(r, r.End(xlDown)).Copy
        newSheet.Activate
        newColumn.Offset(0, numFiles) = wk.Name
        newColumn.Offset(1, numFiles).Select
        newSheet.Paste
        Application.DisplayAlerts = False
        wk.Close False
        Application.DisplayAlerts = True
        s = Dir()
    Wend
    MsgBox (numFiles & " files were processed.")
End Sub

For copy/paste of pictures see examples on this or this page. To find the last cell containing data in a column see this page; note that one example involves using the .find command. More generally, to learn how to use .find in vba, use the macro recorder and then adjust the resulting code.