VBA - How to Cycle through Workbooks to Paste Columns To a Matching Worksheet

[begin_09]

Hi, I'm trying to automate the process of pasting columns from one workbook to another workbook, but the added complexity is that I want excel to partially match up the name of the workbook I'm copying from to the worksheet I'm copying to to ensure that the information is going to the right place. I also want to add Excel to loop through all the workbooks in my folder for all the sheet names I have, so I'm looking for something flexible enough to recognize partial name matches. I googled a lot and can't fit the code together the way I want it to, so would appreciate your help.

The folder I want the code to look through has workbooks whose names are formatted like this:

BH18PRME_BatchCFS_Abcd_201907.csv
AMAR19B6_BatchCFSF_Abcd_201907.csv

When you open up for instance, the first .csv file, it only has one sheet labeled with the same name as the workbook. I want to copy all the info in columns A:P to columns AF:AU on the corresponding AH18PRME sheet in my Master workbook.

My Master workbook has the following tabs:
1. Name Mapping: List of the names I want excel to partially find in the workbook name and then the corresponding sheet name. In the code below, I tried naming the range F4:F5 "Name" so I could refer to it more easily.
2. BH18PRME: I want columns AF:AU on this sheet filled in with the data from the BH18PRME workbook
3. AMAR19B6: I want columns AF:AU on this sheet filled in with the data from the AMAR19B6 workbook
4. AMAR19B6 Complete: Shows columns AF:AU filled in with the data from the AMAR19B6_BatchCFSF_Abcd_201907.csv file

In my code, I refer to two workbooks, one is my Master workbook, and one I call Trepp which is the workbook that is currently open that I need to copy data from. I tried using a counter to go through the list of names I want to match up between my workbook name and worksheet name, but wasn't sure how to code it correctly. I'm also not sure how to add the right If statements in here to say if my excel worksheet name is a partial match to the workbook name, then paste the data in the worksheet.

Below is my code thus far:

Sub open_csv_file2()


Dim sPath As String
Dim sFil As String
Dim strName As String
Dim lasersn As String
Dim wb As String
Dim trepp As Workbook
Dim Masterwb As Workbook
Dim counter As Double


With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With


Set Masterwb = Workbooks("Master Workbook.xlsm")


counter = 1 To Selection.Count


lasersn = Masterwb.Worksheets("Name Mapping").Range("F4").Offset(counter - 1, 0)


sPath = "E:\Cash Flow"
sFil = Dir(sPath & lasersn & "*.csv")


Do While sFil <> ""
strName = sPath & sFil
Workbooks.Open (strName)
Set trepp = Workbooks(sFil)
trepp.Activate


Masterwb.Worksheets("Name Mapping").Range("AF:AU").Value = trepp.Worksheets(1).Range("A:P").Value

Next counter

[Artik]

CSV files are text files, not Excel workbook structure files (to check, open the CSV file in Notepad). The Excel application only cleverly converts these files to the structure of the workbook (basically the data is imported into the empty sheet).
For this reason, I suggest handling them as text files, not as workbooks. It's faster.


I don't understand what you want to achieve in question # 4, so I skipped them in the code.

Sub open_csv_file3()

    Dim sPath       As String
    Dim sFil        As String
    Dim strName     As String
    Dim lasersn     As String
    Dim Masterwb    As Workbook
    Dim rng         As Range
    Dim varData     As Variant
    Dim blnIsFirst  As Boolean
    Dim lFrstRow    As Long


    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With


    Set Masterwb = ThisWorkbook
    
    sPath = "E:\Cash Flow\"


    For Each rng In Masterwb.Worksheets("Name Mapping").Range("Name").Cells
        
        blnIsFirst = True

        lasersn = rng.Value

        sFil = Dir(sPath & lasersn & "*.csv")

        Do While sFil <> ""
            strName = sPath & sFil

            If blnIsFirst Then
                varData = ReadLineFromFile(strName)
                blnIsFirst = False
                lFrstRow = 1
            Else
                varData = ReadLineFromFile(strName, 1)
            End If

            With Masterwb.Worksheets(lasersn).Range("AF" & lFrstRow).Resize(UBound(varData))
              .Value = Application.Transpose(varData)
              .TextToColumns DataType:=xlDelimited, Comma:=True
            End With

            lFrstRow = lFrstRow + UBound(varData)

            sFil = Dir
        Loop

    Next rng


    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub




Function ReadLineFromFile(strFilename As String, _
                          Optional lFrom As Long = -1, _
                          Optional lTo As Long = -1) As Variant
    Dim hf          As Integer
    Dim sArrLines() As String, i As Long
    Dim sLines      As String
    Dim sTmp        As String


    hf = FreeFile

    Open strFilename For Input As #hf
    sLines = Input$(LOF(hf), #hf)
    Close #hf

    sArrLines = Split(sLines, vbNewLine)

    If lTo = -1 Then
        lTo = UBound(sArrLines)
    End If

    If lFrom > -1 Then
        If lTo > -1 Then
            'Lines From...To
            On Error Resume Next
            For i = lFrom To lTo
                sTmp = sTmp & sArrLines(i) & vbNewLine
            Next i

            sTmp = Left(sTmp, Len(sTmp) - Len(vbNewLine))
            On Error GoTo 0

            sArrLines = Split(sTmp, vbNewLine)
        Else
            'one line
            On Error Resume Next
            ReadLineFromFile = sArrLines(lFrom)
            On Error GoTo 0
        End If
    Else
        'all lines
    End If

    ReadLineFromFile = sArrLines
End Function

Artik

[begin_09]

Hi Artik, thanks for your code, it looks much better than mine. I tried to run it, but it's not copying and pasting columns A:P of each data workbook into columns AF:AU of my Master workbook. There's no error that comes up, but my Master workbook columns AF:AU remain blank. I tried stepping through the code, and up until

Do While sFil <> ""

the code goes through line by line, but then it skips all the way to

Next rng

without reading the function in between. It then goes back to the beginning and again skips the function part. I checked to make sure the names in my "Name" range match the names of my tabs in my Master workbook, and they match. I also checked to make sure the names of the tabs are contained in the names of the files that I want to get the data from, and that matches too, so I'm not sure what the problem is.

Some additional details that might be a factor - my files that I want to extract data from are all saved in the E:\Cash Flow path, but my master workbook was not originally saved there, I just had it open to run the macro. I did try saving my master workbook into that path, but it didn't make a difference.