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

我有一个macros允许我将几个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