Ajustement d'un script - Copie de données depuis une source externe

Question

J'utilise maintenant un script (ci-dessous) qui fonctionne bien, même s'il faut beaucoup de travail manuel pour l'utiliser, et l'effet n'est pas à 100% de ce dont j'aurais besoin.

Je voudrais ce script pour copier toujours un contenu d'un fichier fixe (MIS_rapport.csv) et de le coller dans la feuille active d'autres Cahier d'exercices, appelé Based.xls

Toute aide?

Merci d'avance!

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 

Answer 1

Ouverture d'un fichier Separate:

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 

lire ma réponse complète sur This autre poste pour plus de contexte