VBA通过列值将数据parsing到单独的工作表中，并在每个工作表上都有列标题
'请帮我把列标题放到所有的工作表中。 谢谢！
'SAMPLE CODE FROM THIS SITE 'doesn't add column headers to 3+worksheets Sub SplitData() Dim MyFiles As String MyFiles = Dir("C:\Users\jkirby\Desktop\extracted data\*.xlsb") Do While MyFiles <> "" Workbooks.Open "C:\Users\jkirby\Desktop\extracted data\" & MyFiles 'deactivate windows security nag Application.DisplayAlerts = False Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long Set Names = Range("F2:F" & Range("a1").End(xlDown).Row) n = 0 For Each name In Names If name.Offset(1, 0) <> name Then ReDim Preserve DataMarkers(n) DataMarkers(n) = name.Row Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name n = n + 1 End If Next name For i = 0 To UBound(DataMarkers) If i = 0 Then Worksheets(1).Range("A1:ay" & DataMarkers(i)).Copy _ Destination:=Worksheets(i + 2).Range("a1") Else 'won't work because it's not copying column headers Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & _ ":AY" & DataMarkers(i)).Copy _ Destination:=Worksheets(i + 2).Range("a1") End If Next i 'save as binary (for compression and formatting) ActiveWorkbook.saveAs Filename:=Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - 4) & ".xlsb", FileFormat:=xlExcel12 'reactivate windows security nag Application.DisplayAlerts = True 'close the file we just worked on ActiveWorkbook.Close 'Let's do it again until they are all done MyFiles = Dir Loop End Sub 你可能想要改变这个：
'won't work because it's not copying column headers Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & _ ":AY" & DataMarkers(i)).Copy _ Destination:=Worksheets(i + 2).Range("a1")
进入这个：
'won't work because it's not copying column headers Worksheets(1).Range("A" & (DataMarkers(i + 1 - 1) + 1) & _ ":AY" & DataMarkers(i)).Copy _ Destination:=Worksheets(i + 2).Range("a1")
因为在第二种情况下，我可以是1，所以DataMarkers（1-1）返回0，Excel中的列不是从0开始
此外， 我不会build议使用名称或名称作为范围或variablestypes，因为这些是工作表或工作簿范围名称的VBA保留关键字 。
干杯，
帕斯卡尔