我有一个文件夹,每个文件夹包含一致名为“Provider A Product X Month Year”的不同excel文件,每个文件夹只包含一个工作表或标准工作表1,..,工作表3
现在我希望将所有这些工作簿(只有工作簿中的多张工作表中的第一张工作表)合并为一个工作簿,并将所有工作表重命名为“月份年”,与相应的原始文件名相同。我见过Merging Several Workbooks Into One Workbook with All the Workbooks as Sheets部分有帮助,但没有完全回答..
或者,甚至更好,最好将所有文件合并到同一工作表中,彼此之下,并使文件名的“月份年”部分为额外列。即如果我有数据,例如A1:D50然后宏将添加一个新的A列并在每个A1中写入“月份年”:A50
非常感谢任何想法!
由于 马库斯
答案 0 :(得分:1)
尝试一下:
Sub tgr()
Dim wsDest As Worksheet
Dim oShell As Object
Dim strFolderPath As String
Dim strFileName As String
Dim strMonthYear As String
Set oShell = CreateObject("Shell.Application")
On Error Resume Next
strFolderPath = oShell.BrowseForFolder(0, "Select Folder", 0).Self.Path & Application.PathSeparator
Set oShell = Nothing
On Error GoTo 0
If Len(strFolderPath) = 0 Then Exit Sub 'Pressed cancel
Application.ScreenUpdating = False
Set wsDest = Sheets.Add(After:=Sheets(Sheets.Count))
wsDest.Range("A1").Value = "Month Year"
strFileName = Dir(strFolderPath & "*.xls*")
Do While Len(strFileName) > 0
With Workbooks.Open(strFolderPath & strFileName)
.Sheets(1).UsedRange.Copy wsDest.Cells(Rows.Count, "B").End(xlUp).Offset(1)
.Close False
End With
strMonthYear = WorksheetFunction.Trim(Right(Replace(strFileName, " ", String(99, " ")), 198))
wsDest.Range(wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1), wsDest.Cells(Rows.Count, "B").End(xlUp).Offset(, -1)).Value = strMonthYear
strFileName = Dir
Loop
Application.ScreenUpdating = True
Set wsDest = Nothing
End Sub