-1

I'm using now a script (below) that works fine, although it takes to much manual work to use it, and the effect is not 100% of what I would need.

I would like this script to always copy a content of a fixed file (MIS_rapport.csv) and paste it in active sheet of other Workbook, called Based.xls

Any help?

Thanks in advance!

Private Declare Function SetCurrentDirectoryA Lib _
 "kernel32" (ByVal lpPathName As String) As Long



Sub ChDirNet(szPath As String)
     SetCurrentDirectoryA szPath
End Sub

Sub Combine_Workbooks_Select_Files()
     Dim MyPath As String
     Dim SourceRcount As Long, Fnum As Long
     Dim mybook As Workbook, BaseWks As Worksheet
     Dim sourceRange As Range, destrange As Range
     Dim rnum As Long, CalcMode As Long
     Dim SaveDriveDir As String
     Dim FName As Variant

    With Application
         CalcMode = .Calculation
         .Calculation = xlCalculationManual
         .ScreenUpdating = False
         .EnableEvents = False
     End With

    SaveDriveDir = CurDir
     ChDirNet "C:\"

    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
                                         MultiSelect:=True)
     If IsArray(FName) Then
         Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
         rnum = 1
         For Fnum = LBound(FName) To UBound(FName)
             Set mybook = Nothing
             On Error Resume Next
             Set mybook = Workbooks.Open(FName(Fnum))
             On Error GoTo 0
             If Not mybook Is Nothing Then
                 On Error Resume Next
                 With mybook.Worksheets(1)
                     Set sourceRange = .Range("A1:W300")
                 End With
                 If Err.Number > 0 Then
                     Err.Clear
                     Set sourceRange = Nothing
                 Else
         If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                         Set sourceRange = Nothing
                     End If
                 End If
                 On Error GoTo 0

                If Not sourceRange Is Nothing Then

                    SourceRcount = sourceRange.Rows.Count

                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                         MsgBox "Not enough rows in the sheet. "
                         BaseWks.Columns.AutoFit
                         mybook.Close savechanges:=False
                         GoTo ExitTheSub
                     Else
                         Set destrange = BaseWks.Range("A" & rnum)
                         With sourceRange
                             Set destrange = destrange. _
                                             Resize(.Rows.Count, .Columns.Count)
                         End With
                         destrange.Value = sourceRange.Value

                        rnum = rnum + SourceRcount
                     End If
                 End If
                 mybook.Close savechanges:=False
             End If
         Next Fnum
         BaseWks.Columns.AutoFit
     End If
ExitTheSub:
    With Application
         .ScreenUpdating = True
         .EnableEvents = True
         .Calculation = CalcMode
     End With
     ChDirNet SaveDriveDir
 End Sub
Community
  • 1
  • 1
Szymon Sid
  • 11
  • 3

1 Answers1

0

Opening A Seperate File:

ChDir "[Path here]"                          'get into the right folder here
Workbooks.Open Filename:= "[Path here]"      'include the filename in this path

'copy data into workbook using: Sheets("workbookname").Range("A2") or_
'select sheets and use ActiveSheet.

ActiveWindow.Close                          'closes out the file

read my full answer on This other post for more context

Community
  • 1
  • 1
Mike Kellogg
  • 1,168
  • 5
  • 15
  • 34