Hi,
I have macro which import XML files from the folder to new workbook, one XML file for individual sheets, the sheets are named as XML filenames.
All happens by pressing button on macro enabled "master" workbook.
What I want is that when I press button the few more things happens also:
- At first, this code leaves one empty sheet to new workbook before imported XML files sheets - I don't need that feature..
- In new workbook, I want to copy rows "I3, J3 - to the last column that includes data" and paste data to new worksheet,
it would be nice if it's possible to add header to pasted columns to new worksheet, header would be the sheet name. (which is also written in cell C3)
- then loop this through all the sheets in workbook
- I3,J3 from the first sheet could be inserted to A2,B2, and the Header to column to A1,B1 (Sheet name or cell C3 text)
- I3,J3 from the second sheet could be inserted to E2,F2 and the Header to column to E1,F1 (Sheet name or cell C3 text)
- in other words two empty rows between "different sheet datas"
- etc...
If its easier to run actions in master workbook and then copy/cut those to new workbook, that is also ok..?
This is the code what I got by "record macro" feature, I just copied first three sheets for example..
I have macro which import XML files from the folder to new workbook, one XML file for individual sheets, the sheets are named as XML filenames.
All happens by pressing button on macro enabled "master" workbook.
What I want is that when I press button the few more things happens also:
- At first, this code leaves one empty sheet to new workbook before imported XML files sheets - I don't need that feature..
- In new workbook, I want to copy rows "I3, J3 - to the last column that includes data" and paste data to new worksheet,
it would be nice if it's possible to add header to pasted columns to new worksheet, header would be the sheet name. (which is also written in cell C3)
- then loop this through all the sheets in workbook
- I3,J3 from the first sheet could be inserted to A2,B2, and the Header to column to A1,B1 (Sheet name or cell C3 text)
- I3,J3 from the second sheet could be inserted to E2,F2 and the Header to column to E1,F1 (Sheet name or cell C3 text)
- in other words two empty rows between "different sheet datas"
- etc...
Code:
Sub From_XML_To_XL()
Dim xmlWb As Workbook, xSWb As Workbook, xStrPath$, xfdial As FileDialog, xFile$
Set xfdial = Application.FileDialog(msoFileDialogFolderPicker)
xfdial.AllowMultiSelect = False
xfdial.Title = "Select a folder"
If xfdial.Show = -1 Then xStrPath = xfdial.SelectedItems(1) & ""
If xStrPath = "" Then Exit Sub
Set xSWb = Workbooks.Add
xFile = Dir(xStrPath & "\*.xml")
Do While xFile <> ""
Set xmlWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
xSWb.Sheets.Add , xSWb.Worksheets(xSWb.Worksheets.Count)
On Error Resume Next
xSWb.Sheets(xSWb.Worksheets.Count).Name = xmlWb.Sheets(1).[c3]
If Err <> 0 Then
MsgBox "Repeated name, invalid character, name too long..."
On Error GoTo 0
xSWb.Sheets(xSWb.Worksheets.Count).Name = _
Left(xmlWb.Sheets(1).[a3] & Replace(Time, ":", ""), 30)
End If
Err.Clear
xmlWb.Sheets(1).UsedRange.Copy xSWb.Sheets(xSWb.Worksheets.Count).Cells(1, 1)
xmlWb.Close False
xFile = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "End of code - Files opened succesfully to new Workbook."
Exit Sub
ErrHandler:
MsgBox "Error!", , "Tools for Excel."
End Sub
If its easier to run actions in master workbook and then copy/cut those to new workbook, that is also ok..?
This is the code what I got by "record macro" feature, I just copied first three sheets for example..
Code:
Sub CopyRowsToNewWorkSheet()
'
' CopyRowsToNewWorkSheet Macro
'
'
Sheets.Add After:=ActiveSheet
Sheets("calbefinduct.fd2").Select
Range("C3").Select
Selection.Copy
Sheets("Sheet11").Select
Range("A1:B1").Select
ActiveSheet.Paste
Sheets("calbefinduct.fd2").Select
Range("I3:J3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet11").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("calbef.fd2").Select
Range("C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet11").Select
Range("E1").Select
ActiveSheet.Paste
Range("F1").Select
ActiveSheet.Paste
Sheets("calbef.fd2").Select
Range("I3:J3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet11").Select
Range("E2").Select
ActiveSheet.Paste
Sheets("fpa.fd2").Select
Range("C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet11").Select
Range("I1:J1").Select
ActiveSheet.Paste
Sheets("fpa.fd2").Select
Range("I3:J3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet11").Select
Range("I2").Select
ActiveSheet.Paste
End Sub