Question

美好的一天

我需要一些关于以下VBA代码的帮助，我希望excel执行以下操作：

打开多个XML文件
将文件格式化为仅反映某些列
将所有信息粘贴到每个其他

当在一张纸上合并时，代码还需要删除第1行中的标题行。

这是我到目前为止所拥有的

Sub Combined()

'UpdatebyKutoolsforExcel20151214
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long

'added
Dim LastRow As Long 'new line

On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then
    xStrPath = xFileDialog.SelectedItems(1)
End If

If xStrPath = "" Then Exit Sub

Application.ScreenUpdating = False

'probleem le by die "usedrange"
'hy moet net begin copy by n sekere plek, en tot n sekere plek
Set xSWb = ThisWorkbook
xCount = 1 'lyntjie waar hy moet paste

xFile = Dir(xStrPath & "\*.xml") 'alle file met .xml in folder
Do While xFile <> ""
    Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile, LoadOption:=xlXmlLoadImportToList)

    'copy van xWb.sheet na ons xSWb.sheet
    LastRow = xWb.Sheets(1).Range("A1048576").End(xlUp).Row 'new line
    'MsgBox LastRow

    If xCount = 1 Then 'just to copy headers if this is the 1st file (New lines)
     xWb.Sheets(1).Range("A1:BQ1").Copy xSWb.Sheets(1).Cells(xCount, 1)
     xCount = 2
    End If


    'xWb.Sheets(1).UsedRange.Copy xSWb.Sheets(1).Cells(xCount, 1) 'copy in cell 2,1 PROBLEEM HIER
    xWb.Sheets(1).Range("A2:BQ" & LastRow & "").Copy xSWb.Sheets(1).Cells(xCount, 1)

    xWb.Close False

    LastRow = xSWb.Sheets(1).Range("A1048576").End(xlUp).Row 'new line - kry laaste ryjite van ons huidige werkboek
    xCount = LastRow + 1 'new line
    'xCount = xSWb.Sheets(1).UsedRange.Rows.Count + 2 'update waar hy nou na moet copy
    xFile = Dir()
Loop

Application.ScreenUpdating = True

xSWb.Save
Exit Sub
ErrHandler:
    MsgBox "no files xml", , "Kutools for Excel"

End Sub

任何帮助将不胜感激

将XML文件导入+格式化为Excel

0 个答案: