Copy the Client "N' number of times to column A if there is data worth "N" rows

[SharmaAntriksh]

Hello There!

i am working on a project where i have been given 1200 files and all i have to do is to copy paste the data from 1200 file to 1 file under the given column headers(Headers are the same in 1200 files) i have already written a Macro to resolve this, it works fine in terms of copying the data but the problem i face is that the client name which is listed on the top cells(row 1 is merged in terms of the columns lets say A1:A7) there is a client name that i also need to copy and paste to that master workbook under column a, but the catch is the name should be copied the same number of times as the number of rows worth data was in the file from which i copied below are 2 sample tables and then is the code.

Samsung	<-This whole row is merged in those 1200 files(and inside it is the client name ->	--	----	---------
Carrier Name	Commission	Legal Entity	AMBEST Rating	Time Period
xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018

<tbody>
</tbody>

Below is how the Code works currently

Client Name	Carrier Name	Commission	Legal Entity	AMBEST Rating	Time Period
Samsung	xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
	xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
	xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
	xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
Apple	xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
	zyx	xyz	xyz	xyz	1/1/2018 -12/31/2018
	xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
AT&T	xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018
	xyz	xyz	xyz	xyz	1/1/2018 -12/31/2018

<tbody>
</tbody>

as you can clearly see from the second table that it copies the data perfectly but it only copies the name once, if you could suggest me way to tackle this it will be really helpful

Sub CdsAutomation()
    
    Dim Fso As Scripting.FileSystemObject
    Dim CdsFolder As Scripting.Folder
    Dim CdsFile As Scripting.File
    Dim cdsFolderPath As String
    Dim MasterWorkbook As Excel.Workbook
    Dim RangeToCopy As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    Set Fso = New Scripting.FileSystemObject
    Set MasterWorkbook = Workbooks("zFile.xlsm")
    
    cdsFolderPath = "C:\Users\Sony\Desktop\CDS Forms\"
    
    Set CdsFolder = Fso.GetFolder(cdsFolderPath)
    
    For Each CdsFile In CdsFolder.Files
        
        If CdsFile.Name = MasterWorkbook.Name Then
            Exit Sub
        Else
            
            Workbooks.Open (CdsFile)
            
            Set RangeToCopy = Range("A1")
            
            MasterWorkbook.Worksheets("sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, -1).Value = RangeToCopy.Value
            
            Set RangeToCopy = Range("A2", Range("A2").End(xlToRight).End(xlDown))
            
            RangeToCopy.Copy


            MasterWorkbook.Worksheets("sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAllUsingSourceTheme
            
            If CdsFile.Name = MasterWorkbook.Name Then
                Exit Sub
            Else
                ActiveWorkbook.Close
            End If
        
        End If


    Next CdsFile
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    
    Set Fso = Nothing
    
End Sub

 

[hennahairgel]

Here's a quick loop to resolve the issue. Run it once all the data has been copied into the master workbook.

<code>
For i = 2 To Cells.CurrentRegion.Rows.Count
If Cells(i, 1).Value <> "" Then
carrier = Cells(i, 1).Value
Else
Cells(i, 1).Value = carrier
End If
Next i
</code>