既存のシートの隣にあるシートにXLSファイルを追加する

Question

グラフを作成してブックに2枚追加するマクロがあります。特定のフォルダからExcelファイルのデータをプルするシートを追加し、他の2枚より前のシートにExcelファイルを追加するにはどうすればよいですか？追加するには

Private Sub Workbook_Open() 

    Dim files(1 To 20) As String 
    Dim numOfFiles As Integer 
    Dim chartName As String 
    Dim FilePath As String 
    Dim strPath As String 
    Dim strFile As String 
    Dim strFile1 As String 
    Dim strChart As String 
    Dim i As Integer 
    Dim j As Integer 


    strPath = "C:\PortableRvR\report\" 
    strFile = Dir(strPath & "*.csv") 
    i = 1 
    Do While strFile <> "" 
     With ActiveWorkbook.Worksheets.Add 
      With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _ 
       Destination:=.Range("A1")) 
       .Parent.Name = Replace(strFile, ".csv", "") 
       .TextFileParseType = xlDelimited 
       .TextFileTextQualifier = xlTextQualifierDoubleQuote 
       .TextFileConsecutiveDelimiter = False 
       .TextFileTabDelimiter = False 
       .TextFileSemicolonDelimiter = False 
       .TextFileCommaDelimiter = True 
       .TextFileSpaceDelimiter = False 
       .TextFileColumnDataTypes = Array(1) 
       .TextFileTrailingMinusNumbers = True 
       .Refresh BackgroundQuery:=False 
       files(i) = .Parent.Name 
       i = i + 1 
      End With 
     End With 
     strFile = Dir 
    Loop 

    chartName = "Chart 8" 
    For j = 1 To numOfFiles 
     strFile = files(j) 
     Sheets(strFile).Select 
     Plot_y = Range("E1", Selection.End(xlDown)).Rows.Count 
     Plot_x = Range("D1", Selection.End(xlDown)).Rows.Count 

     Sheets("Uplink VS attenuation").Select 
     If j = 1 Then ActiveSheet.ChartObjects(chartName).Activate 

     With ActiveChart 

      .HasTitle = True 
      .ChartTitle.Characters.Text = "TxPower" 
      .Axes(xlCategory, xlPrimary).HasTitle = True 
      .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Attenuation(dB)" 
      .Axes(xlValue, xlPrimary).HasTitle = True 
      .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "TxPower(dBm)" 
      .Axes(xlCategory, xlPrimary).MinimumScale = 30 ' Constant value 

     End With 

     ActiveChart.SeriesCollection.NewSeries 
     ActiveChart.SeriesCollection(j).Name = strFile 
     ActiveChart.SeriesCollection(j).XValues = Sheets(strFile).Range("D1:D" & Plot_x) 
     ActiveChart.SeriesCollection(j).Values = Sheets(strFile).Range("E1:E" & Plot_y) 
     ActiveChart.SeriesCollection(j).MarkerStyle = -4142 
     ActiveChart.SeriesCollection(j).Smooth = False 
    Next j 

    ActiveSheet.ChartObjects(chartName).Activate 
    ActiveChart.Axes(xlValue).DisplayUnit = xlMillions 
    ActiveChart.Axes(xlValue).HasDisplayUnitLabel = False 
End Sub 

Answer 1

がSheets("Uplink VS attenuation")を持ってSample.txtをからBook2.xlsxにシート1を、言って、あなたはあなたのニーズに合わせて、それを修正してください。このサンプルコード

を使用することができます。

Sub Sample() 
    Dim wb As Workbook, wbTemp As Workbook 
    Dim ws As Worksheet, wsTemp As Worksheet 

    '~~> This is the workbook which has the "Uplink VS attenuation" sheet 
    Set wb = ThisWorkbook 
    Set ws = Sheets("Uplink VS attenuation") 

    '~~> Open the relevant text file. Change as applicable 
    Workbooks.OpenText Filename:="C:\Temp\Sample.txt", Origin:=437, _ 
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ 
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _ 
    Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _ 
    TrailingMinusNumbers:=True 

    Set wbTemp = ActiveWorkbook 
    Set wsTemp = wbTemp.Sheets(1) 

    '~~> Copy the relevant sheet before "Uplink VS attenuation" 
    wsTemp.Copy Before:=ws 

    '~~> Close text file without saving 
    wbTemp.Close savechanges:=False 

    '~~> Clean Up 
    Set wb = Nothing: Set wbTemp = Nothing 
    Set ws = Nothing: Set wsTemp = Nothing 
End Sub 

注：私はすべてのエラー処理を行っていません。私はあなたがそれの世話をすることができます確信している:)

HTH

シド