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

SharmaAntriksh

New Member
Joined
Nov 8, 2017
Messages
31
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.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Samsung[/TD]
[TD]<-This whole row is merged in those 1200 files(and inside it is the client name ->[/TD]
[TD]--[/TD]
[TD]----[/TD]
[TD]---------[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Carrier Name[/TD]
[TD]Commission[/TD]
[TD]Legal Entity[/TD]
[TD]AMBEST Rating[/TD]
[TD]Time Period[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Below is how the Code works currently

[TABLE="width: 500"]
<tbody>[TR]
[TD]Client Name[/TD]
[TD]Carrier Name[/TD]
[TD]Commission[/TD]
[TD]Legal Entity[/TD]
[TD]AMBEST Rating[/TD]
[TD]Time Period[/TD]
[/TR]
[TR]
[TD]Samsung[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]zyx[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
[TR]
[TD]AT&T[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]xyz[/TD]
[TD]1/1/2018 -12/31/2018[/TD]
[/TR]
</tbody>[/TABLE]


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


Code:
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
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
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>
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

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