-1

私は現在、正常に機能するスクリプト（以下）を使用していますが、それを使用するには多くの手作業が必要であり、その効果は私が必要とするものの100％ではありません。

このスクリプトで、固定ファイル（MIS_rapport.csv）のコンテンツを常にコピーし、Based.xlsと呼ばれる他のワークブックのアクティブシートに貼り付けたいと思います。

何か助けはありますか？

前もって感謝します！

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
4

1 に答える 1

0

別のファイルを開く：

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

詳細については、この他の投稿の私の完全な回答を読んでください

于 2012-11-05T18:48:02.610 に答える