Compile Data without Column Headers

[Deepak Sharma]

Hello Everyone,

I have written a code to compile workbooks from a specific folder through Loops, but issues I am having are :-
1. I need to compile column headings only once Like...when I run the code then first file should open and paste everything whatever it has WITH Column Headings BUT next File's data should copy & paste WITHOUT Column Headings.

2. Folder has other files also but I need to run only those files whose name starts from "CSC".

3. Lastly it shows Active X Error on closing.

Please see the attached file !

Regards,
Deepak Sharma

 

[chirayu]

ActiveX Error usually occurs due to Trust Center settings, when you have disabled the file saving any personal information i.e. username etc. refer to below link

https://support.office.com/en-us/ar...ce-files-f1303e08-a3f8-41c5-a17e-b0b8898743ed

Do headers in each of your files start in row 1? if so then use below code

Sub WB_Compiler()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Define Variables
Dim Curr As String
Dim fso As Object
Dim fol As Object
Dim fil As Object
Dim path As String
Dim fold As Object
Dim LstRow As Integer
Dim LstCol As String
Dim FName As String
Dim i As Integer

'Set Variables
Curr = ActiveWorkbook.Name
Set fold = Application.FileDialog(msoFileDialogFolderPicker)
With fold
    .Title = "Select The Folder"
    .Show
End With
path = fold.SelectedItems(1)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder(path)

'Clear Old data
Worksheets("WB Compiler").Select
Cells.Delete

'Loop through files
i = 0
For Each fil In fol.Files
   
    i = i + 1
   
    'Open file with CSC prefix
    If fil.Name Like "CSC*" Then
        Workbooks.Open(Filename:=path & "\" & fil.Name, UpdateLinks:=False, ReadOnly:=True).Activate
        FName = ActiveWorkbook.Name
       
        'Copy data from A1 to last column last row
        Range("A1").Select
        LstRow = Cells(Rows.Count, "A").End(xlUp).Row
        Selection.End(xlToRight).Select
        LstCol = Split(ActiveCell.Address, "$")(1)
        If i = 1 Then
            Range("A1:" & LstCol & LstRow).Copy
        Else
            Range("A2:" & LstCol & LstRow).Copy
        End If
           
            'Paste data
            Windows(Curr).Activate
            Range("A" & Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
           
            'Close the CSC file
            Workbooks(FName).Close savechanges:=False
           
    Else
    End If

Next fil

'Finish
Range("A:F").EntireColumn.AutoFit
Range("A1").Select
MsgBox "Macro completed. " & i & " files copied", vbInformation, ""

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[Deepak Sharma]

Amazing Bro! Wonderfull!
So Sorry for late reply!

Chirayu, actually my sheet is blank and that's why I wanted to copy the first sheet with column headings A1 & then data only from other sheets A2. Anyways I have deleted the first row with code. Its working fine now.

1. Another thing actually I have other excel sheets also in that folder that's why you have also applied "CSC" files to be copy paste only. But I think when loop starts so takes "I" as 1 with other excel file, so the moment it comes to the "CSC" file, it becomes 3 or 4 that's why column heading is not getting pasted.
Data is coming exactly from only "CSC" files, which is perfect !

2. At the end also Msgbox shows the value of "I" which counts all the excel files.

3. Lastly Is it also possible to copy data from the matching sheet name to ThisWB's matching sheet names.

For eg. I have 5 Files with 5 sheets in each file, Data should only be copy/pasted from sheet names "Payment Status" & "CSP Wise".

I hope you got it! If not please ping me. I am attaching files for your ref.!

Thank You !!!!

Regards,
Deepak Sharma

 

[chirayu]

made the changes. test it

 

[Deepak Sharma]

Thank you so so much Chirayu! It's working amazingly fine now.

You are a genius.....

Thankssssss and Regards,
Deepak Sharma