将工作簿合并到一个主工作表中
我目前运行2个macros。
1）把我的文件夹中的所有csv，并打开它们全部在一个工作簿 – 这工作正常。
2）将它们全部合并到主工作表中。
我的问题是2.它跳过一些文件。 这是大约250个CSV文件，我试图把它放到一个。 一些工作簿将是空白的，但仍然有标题。 标题都是一样的。
这里是代码：
Sub Merge2MultiSheets() Dim wbDst As Workbook Dim wbSrc As Workbook Dim wsSrc As Worksheet Dim MyPath As String Dim strFilename As String Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False MyPath = "PATH" ' change to suit Set wbDst = Workbooks.Add(xlWBATWorksheet) strFilename = Dir(MyPath & "\*.csv", vbNormal) If Len(strFilename) = 0 Then Exit Sub Do Until strFilename = "" Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename) Set wsSrc = wbSrc.Worksheets(1) wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count) wbSrc.Close False strFilename = Dir() Loop wbDst.Worksheets(1).Delete Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub 和
Sub CopyFromWorksheets() Dim wrk As Workbook 'Workbook object - Always good to work with object variables Dim sht As Worksheet 'Object for handling worksheets in loop Dim trg As Worksheet 'Master Worksheet Dim rng As Range 'Range object Dim colCount As Integer 'Column count in tables in the worksheets Set wrk = ActiveWorkbook 'Working in active workbook For Each sht In wrk.Worksheets If sht.Name = "Master" Then MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ "Please remove or rename this worksheet since 'Master' would be" & _ "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" Exit Sub End If Next sht 'We don't want screen updating Application.ScreenUpdating = False 'Add new worksheet as the last worksheet Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 'Rename the new worksheet trg.Name = "Master" 'Get column headers from the first worksheet 'Column count first Set sht = wrk.Worksheets(1) colCount = sht.Cells(1, 255).End(xlToLeft).Column 'Now retrieve headers, no copy&paste needed With trg.Cells(1, 1).Resize(1, colCount) .Value = sht.Cells(1, 1).Resize(1, colCount).Value 'Set font as bold .Font.Bold = True End With 'We can start loop For Each sht In wrk.Worksheets 'If worksheet in loop is the last one, stop execution (it is Master worksheet) If sht.Index = wrk.Worksheets.Count Then Exit For End If 'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 'Put data into the Master worksheet trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value Next sht 'Fit the columns in Master worksheet trg.Columns.AutoFit 'Screen updating should be activated Application.ScreenUpdating = True End Sub
我的标题从A3：C3，上面的数据是不需要的。
通过将CSV工作表复制到工作簿中，然后将数据复制到主选项卡，可以完成不必要的工作。 只需将CSV中的数据直接导入预加载的主选项卡（模板）即可。
此代码假定工作簿中有1个工作表，将运行已经定义了标题的代码。 请参阅关于将10调整为实际拥有的列标题数的说明。
Option Explicit Sub LoadCSVs() Dim wsDest As Worksheet Set wsDest = ThisWorkbook.Worksheets("Master") With wsDest 'clear old data if needed If Len(.Range("B2")) Then Intersect(.UsedRange, .UsedRange.Offset(1)).Clear 'removes old data End If End With Application.ScreenUpdating = False Dim MyPath As String MyPath = "PATH" ' change to suit Dim strFilename As String strFilename = Dir(MyPath & "\*.csv", vbNormal) If Len(strFilename) = 0 Then Exit Sub Do Until strFilename = "" Dim wbSrc As Workbook Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename) Dim wsSrc As Worksheet Set wsSrc = wbSrc.Worksheets(1) With wsSrc If Len(.Range("B2")) Then Dim vData As Variant 'load data to variant vData = Intersect(.UsedRange, .UsedRange.Offset(1)) 'place on master tab 'adjust to column header length wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Offset(1).Resize(UBound(vData), 10).Value = vData End If End With wbSrc.Close False strFilename = Dir() Loop End Sub
该指数可能不可靠，你可能过早退出循环。
For Each sht In wrk.Worksheets If sht.Name <> "Master" 'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 'Put data into the Master worksheet trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value End If Next sht
