• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help in.. copy paste special values instead of simply copy and paste

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.






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
 

Attachments

  • Appends.xlsm
    13.7 KB · Views: 2
change the line:

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

to two lines:
Code:
  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).PasteSpecial Paste:=xlPasteValues
 
Thanks Hui..its working fine, however there are few records mainly the last row is not pasting properly from some excel files in to the consolidation File.

Is there anything I missed in the code.

Apprecaite your help.

Marked in yellow for few fields are blanks.


upload_2017-8-28_14-39-15.png
 
without data it's hard to work it out

I would add 2 lines before the 2 lines I gave you above
ie:
Code:
Debug.Print ActiveWorkbook.Sheets(x).Range(ActiveWorkbook.Sheets(x).Cells(2, j), ActiveWorkbook.Sheets(x).Cells(ActiveWorkbook.Sheets(x).UsedRange.Rows.Count, j)).Address
Debug.Print tgtWbk.Sheets(x).Range(Cells(Rows.Count, i).Address).End(xlUp).Offset(1, 0).Address
msgbox "Check the immediate window"
' the existing 2 lines are here

Run it and look in the immediate window and check the addresses
 
Hi Hui,

I am trying to append two files with the macro as we worked on.
But the problem is its copying the data well from col A to col J but the date its trying to consolidating is having Errors for Column K and L.

Have attached two files( source 1 and Source 2 )
Output file ( Error rows marked in Red)

Please help me on the same..as I am not able to fix this from my end.
Appreciate your help on the same.

Thank you again for all your responses till now.
 

Attachments

  • Source -1.XLSX
    43 KB · Views: 0
  • Source -2.XLSX
    43.5 KB · Views: 0
  • output.xlsx
    11.8 KB · Views: 0
Back
Top