PDA

View Full Version : [SOLVED] Importing worksheets and retaining file order



pdsheep
02-06-2017, 02:14 PM
I have a folder with several hundred files of data that was exported from another program to Excel files. There's a Main spreadsheet and then individual workbooks that have extra data that corresponds to a specific row in the Main. Column A in Main has a numerical primary key for each row and each of those individual files is named with that primary key (so: "1," "2," "3," etc.). I'm trying to import all of those individual files into the Main workbook as new worksheets. Then I need to copy the data from each worksheet and paste it into the corresponding row in the Main sheet. The data in those individual sheets is in multiple rows in column A, so it needs to be transposed when pasted in Main.

I've cobbled together a couple of macros (below) that work, but the file order isn't retained as the files are imported as new sheets. Unfortunately instead of adding file 1 as sheet 2, file 2 as sheet 3, file 3 as sheet 4, etc., it adds them as file 1 as sheet 2, file 10 as sheet 3, file 100 as sheet 4, and so on.

Any help is greatly appreciated!



Sub AppendWorksheets()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer


Application.ScreenUpdating = False
Application.DisplayAlerts = False


directory = "[path]"
fileName = Dir(directory & "*.xl??")


Do While fileName <> "Main.xlsx"
Workbooks.Open (directory & fileName)

For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("Main.xlsx").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("Main.xlsx").Worksheets(total)
Next sheet

Workbooks(fileName).Close
fileName = Dir()
Loop


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub


Sub CopyDataToMain()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim CopyRng As Range
Dim LastRow As Long


With Application
.ScreenUpdating = False
.EnableEvents = False
End With




Set DestSh = Sheet1
Set sh = Sheet1


For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> DestSh.Name Then


LastRow = DestSh.Cells(Rows.Count, 5).End(xlUp).Row


Set CopyRng = sh.Range("A1:A30")


CopyRng.Copy
DestSh.Cells(LastRow + 1, 5).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False

End If
Next


Application.Goto DestSh.Cells(1)


With Application
.ScreenUpdating = True
.EnableEvents = True
End With


End Sub