在excel中現有工作表旁邊的工作表中添加XLS文件

Question

我有一個宏，它填充一個圖形並將兩個工作表添加到工作簿中。我如何添加一張從特定文件夾中拉出Excel文件中的數據並將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

要添加工作表Sheet1說從Sample.txt的到Book2.xlsx，其中有Sheets("Uplink VS attenuation")，您可以使用此示例代碼

請修改它來滿足您的需求。

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

希德