Dinesh_Excel
Member
Hello Friends,
I have a code which consolidates many numbers of Excel Data in one consolidated File.
The issue here is its simply copy and pastes the data in the consolidated File ,where as I need something where it should copy and paste special values in the consolidated File.
Attached Code for your reference.
I have a code which consolidates many numbers of Excel Data in one consolidated File.
The issue here is its simply copy and pastes the data in the consolidated File ,where as I need something where it should copy and paste special values in the consolidated File.
Attached Code for your reference.
Code:
Sub consolidateEx()
'select a folder
MsgBox "Please select source folder"
Dim folPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select source folder"
.Show
folPath = .SelectedItems(1)
End With
MsgBox "Please select consolidate file"
Dim tgtpath As String
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select target excel workbook"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx;*.xls"
.Show
tgtpath = .SelectedItems(1)
End With
Dim tgtWbk As Workbook
Set tgtWbk = Workbooks.Open(tgtpath)
'get details of the folder
Dim fs As Object, fol As Object
Set fs = CreateObject("scripting.filesystemobject")
Set fol = fs.getFolder(folPath)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'open each wbk and copy the data into activeworkbook
Dim TgtColCount As Integer, i As Integer, j As Integer
Dim f As Object, x As Integer
For Each f In fol.Files
If UCase(fs.getExtensionName(f.Name)) = "XLSX" Then
Workbooks.Open f.Path
For x = 1 To tgtWbk.Sheets.Count
TgtColCount = tgtWbk.Sheets(x).UsedRange.Columns.Count
For i = 1 To TgtColCount
For j = 1 To ActiveWorkbook.Sheets(x).UsedRange.Columns.Count
If UCase(tgtWbk.Sheets(x).Cells(1, i)) = UCase(ActiveWorkbook.Sheets(x).Cells(1, j)) Then
ActiveWorkbook.Sheets(x).Range(ActiveWorkbook.Sheets(x).Cells(2, j), ActiveWorkbook.Sheets(x).Cells(ActiveWorkbook.Sheets(x).UsedRange.Rows.Count, j)).Copy _
tgtWbk.Sheets(x).Range(Cells(Rows.Count, i).Address).End(xlUp).Offset(1, 0)
End If
Next j
Next i
Next x
ActiveWorkbook.Close False
End If
Next
Set f = Nothing: Set fol = Nothing: Set fs = Nothing
Application.DisplayAlerts = True: Application.ScreenUpdating = True
tgtWbk.Sheets(1).Columns.AutoFit
' tgtWbk.Save
MsgBox "done"
End Sub