Excel VBA file importing data from several files located in same folder -> challenge to copy data only (rest is working perfectly)

[harmless92]

Hello,

I have built an excel file with a macro "Compilation_Analysis()" to import a set of data from other excel files located in the same folder.
The VBA is working well, however, I want to copy the data as "data only".

I tried this piece of code but it does not work and I don't know why:
Set Dest = Dest.Offset(2 - Dest.Row, 1)
Source.Copy Dest.PasteSpecial(xlPasteValuesAndNumberFormats)

While with "Source.Copy Dest" it works but paste all format/formulas as well.

Could you help me ?
Thank you in advance.

Below the full code:

Option Explicit

Sub Compilation_Analysis()
  Dim Temp As Variant
  Dim WB As Workbook
  Dim MyFiles As New Collection
  Dim Dest As Range, Source As Range
 
 
 
  'Cette fonction vient charger dans ma variable "Temp" l'ensemble des fichiers présents dans le même répertoire que le fichier qui contient ma macro
  Temp = Dir(ThisWorkbook.Path & "\*.xls")
 
  Do While Temp <> ""
      
    If StrComp(Temp, ThisWorkbook.Name, vbTextCompare) <> 0 Then MyFiles.Add Temp
    'Get next file
    Temp = Dir
  Loop
 
  'Anything to do?
  If MyFiles.Count = 0 Then Exit Sub

  Application.DisplayAlerts = False
 
  For Each Temp In MyFiles
    'Open the file
    Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & Temp)
    
    '!!! IMPORTANT: LA SELECTION A COPIER DEPEND DE CETTE LIGNE DE CODE !!!
    'Copy all data in the range of the name "Offer_Supplier" of each workbook
    Set Source = WB.Sheets(6).Range("Offer_Supplier")
    'Code Alternatif -> si je n'avais défini au préalable une zone à importer dans le(s) fichier(s) source(s), un code alternatif ci-dessous qui va aller important toutes les cellules avec du contenu à partir de la cellulle A3
    'Set Source = Range(WB.Sheets(1).Range("A3"), SheetLastCell(WB.Sheets(1)))
    
    'Set the destination
    Set Dest = SheetLastCell(ThisWorkbook.Sheets(1))
    
    'Enough space
    If Dest.Row = Rows.Count Or Dest.Row + Source.Rows.Count > Rows.Count Then
      MsgBox "Not enough space"
      GoTo ExitPoint
    End If
    
    'Next line first column
    'Ligne de code ci-dessous à utiliser pour copier les fichiers en lignes
    'Set Dest = Dest.Offset(1, 1 - Dest.Column)
    
    'Next columne second line
    'Ligne de code ci-dessous à utliser pour copiers les fichiers en colonnes (dans l'exemple ci-dessous à partir de la ligne 2)
    Set Dest = Dest.Offset(2 - Dest.Row, 1)
    '??? NE FONCTIONNE PAS (A CHECKER POUR REUSSIR A COPIER EN VALEUR SEULE) Source.Copy Dest.PasteSpecial(xlPasteValuesAndNumberFormats)
    Source.Copy Dest
    
    'Close the document without saving the modifications
    WB.Close SaveChanges:=False
 
  Next

ExitPoint:
  Application.DisplayAlerts = True

End Sub



Private Function SheetLastCell(Optional Ws As Worksheet) As Range
  'Returns the last filled cell (intersection row/column) of the table
  Dim R As Range, C As Range
  If Ws Is Nothing Then Set Ws = ActiveSheet
  On Error Resume Next
  Set R = Ws.Cells.SpecialCells(xlCellTypeLastCell)
  On Error GoTo 0
  If R Is Nothing Then
    'Table is protected
    Set R = Ws.Cells(1, 1)
    GoTo FindCell
  End If
  If R.Count > 1 Then
    'Special cells does not work in an event that is triggered by a macro
    If Val(Application.Version) < 10 Then
      Set R = Ws.Cells(1, 1)
      GoTo FindCell
    Else
      'Find also doesn't work in XL2000
      Set R = Ws.UsedRange
      Set SheetLastCell = R.Cells(R.Cells.Count)
      Exit Function
    End If
  End If
  If IsEmpty(R) And Not R.Address = Cells(1, 1).Address Then
FindCell:
    Set C = Ws.Cells.Find("*", After:=R, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
    If C Is Nothing Then
      Set SheetLastCell = Ws.Cells(1, 1)
    Else
      Set R = Ws.Cells.Find("*", After:=R, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
      Set SheetLastCell = Ws.Cells(R.Row, C.Column)
    End If
  Else
    Set SheetLastCell = R
  End If
End Function

 

[NdNoviceHlp]

Hi * harmless92 and Welcome to the Board! Seems like you could replace your copy/paste line of code with the following code. HTH. Dave

Dest.Resize(Scource.Rows.Count, Scource.Columns.Count).Cells.Value = Scource.Cells.Value

 

[harmless92]

Thank you, there was a typo in the code but with the correction Scourse -> source in your line, works perfectly. Thank you.

Dest.Resize(Source.Rows.Count, Source.Columns.Count).Cells.Value = Source.Cells.Value

 

[NdNoviceHlp]

Whoops on the typo. You are welcome. Thanks for posting your outcome. Have a nice day. Dave