Question

我有一个宏，它允许我将几个csv文件的数据导入到包含多个工作表的工作簿中：

Option Explicit
Sub ImportCSVs()
'Import all CSV files from a folder into separate sheets

Dim fPath   As String
Dim fCSV    As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook

Set wbMST = ActiveWorkbook

'Update the path to your CSV files below. Add your-username and your-folder
'Don't remove the the final \ from the file path

fPath = "C:\Users\your-username\Documents\your-folder\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fCSV = Dir(fPath & "*.csv")

    Do While Len(fCSV) > 0
        Set wbCSV = Workbooks.Open(fPath & fCSV)
        ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)

        fCSV = Dir
    Loop

Set wbCSV = Nothing

Application.ScreenUpdating = True
End Sub

我想将每个csv文件放到同一个Excel文件中，因此，当csv完成后，转到（A，B，C ....）之后的列

希望现有代码可以实现......

Answer 1

这假设所有csv都在顶行的每一列中都有数据

Sub ImportCSVs()
 'Import all CSV files from a folder into separate sheets

 Dim fPath   As String
 Dim fCSV    As String
 Dim wbCSV   As Workbook
 'Dim wbMST   As Workbook
 Dim target as range

 'Set wbMST = ActiveWorkbook
  set target = activeworkbook.worksheets(1).range("a1")

 'Update the path to your CSV files below. Add your-username and your-folder
 'Don't remove the the final \ from the file path

 fPath = "C:\Users\your-username\Documents\your-folder\"
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 fCSV = Dir(fPath & "*.csv")

Do While Len(fCSV) > 0
    Set wbCSV = Workbooks.Open(fPath & fCSV)
    'ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
    wbcsv.sheets(1).usedrange.copy target
   set target = target.offset(0,target.currentregion.columns.count +1)
    '=======================New Line
     wbcsv.close False
     '==========End New line
    fCSV = Dir
Loop

 Set wbCSV = Nothing

 Application.ScreenUpdating = True
 End Sub

Answer 2

此代码可能会满足您的条件以及添加到重命名工作表的代码。

Sub ImportCSVs()
'Import all CSV files from a folder into separate sheets

Dim fPath   As String
Dim fCSV    As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook

Set wbMST = ThisWorkbook

'Update the path to your CSV files below. Add your-username and your-folder
'Don't remove the the final \ from the file path

fPath = "C:\Users\your-username\Documents\your-folder\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fCSV = Dir(fPath & "*.CSV")

    Do While Len(fCSV) > 0
        Set wbCSV = Workbooks.Open(fPath & fCSV)
      wbCSV.ActiveSheet.Copy wbMST.ActiveSheet
      With wbMST
      Sheets(ActiveSheet.Name).Name = Left(fCSV, 6)
      'Sheets.Add
      End With
        fCSV = Dir
    Loop

Set wbCSV = Nothing

Application.ScreenUpdating = True
End Sub

在csv文件结束后并排放置数据

2 个答案: