VBA to Concatenate across multiple workbooks

Tooflychicken

New Member
Joined
Oct 1, 2019
Messages
1
I'm trying to write a VBA that will concatenate the same cell across a whole folder of workbooks.

Each workbook in the file is the same, just a different topic. I have 15 different workbooks, for example I have Lion, Tiger, and Panther. In sheet 3 column D of each of these books I have some text.

I want Cat, my master book, to combine the text for each workbook in column D.

So Cat's Sheet 3 D4 will Concatenate Lion's sheet 3 D4, Tigers sheer 3 D4, and Panthers sheet 3 D4.

I would want to do this across all of sheet 3 column D (from D3 - D40), but I don't need any other column of any other sheet.

I hardly know where to start!! I'd love help, assistance, resources, or bits of code that you might find useful!!
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Hi Tooflychicken,

Welcome to MrExcel!!

Try this (just change the setting of the two variables I marked as 'Change to suit'):

Code:
Option Explicit
Sub Macro1()

    Dim strFolder As String
    Dim strExtn As String
    Dim varFileName As Variant
    Dim rngMyCell As Range
    
    Application.ScreenUpdating = False
        
    strFolder = "C:\Sxamples\" 'Directory with files. Change to suit.
    
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If
    
    varFileName = Dir(strFolder)
    Do Until Len(varFileName) = 0
        strExtn = Trim(Right(varFileName, Len(varFileName) - InStrRev(varFileName, ".")))
        If strExtn Like "xls*" Then
            For Each rngMyCell In ThisWorkbook.Sheets("Cat").Range("D3:D40") 'Range to be linked. Change to suit.
                If Len(rngMyCell) = 0 Then
                    rngMyCell.Formula = "='" & strFolder & "[" & varFileName & "]Sheet3'!" & rngMyCell.Address
                Else
                    rngMyCell.Formula = rngMyCell.Formula & "+'" & strFolder & "[" & varFileName & "]Sheet3'!" & rngMyCell.Address
                End If
            Next rngMyCell
        End If
    varFileName = Dir
    Loop
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top