Question

代码工作正常，因为它从名为Trippings_15的不同工作簿的工作表中导入数据。

但是当我在代码中使用Trippings_Jan_15, Trippings_Feb_15, Trippings_March_15, etc时，我希望程序分别从workbook 1,2,3导入名为Trippings_15的工作表，或者我可以简单地给出该工作表的绝对地址，而不管选项卡名称如何像所有工作簿中的sheet7一样。

我正在创建一个数据库，其中2015年的所有月度分数将显示为单页。

 Sub copyDataFromMultipleWorkbooksIntoMaster()

    Dim FolderPath As String, Filepath As String, Filename As String
    FolderPath = "D:\Copy Multiple Excel to One master\"
    Filepath = FolderPath & "*.xls*"

    Dim lastRow As Long, lastCol As Long, eRow As Long
    Dim wb As Workbook, ws As Worksheet
    Application.DisplayAlerts = False

    Filename = Dir(Filepath)
    Do While Filename <> ""
        eRow = Sheet1.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
        Set wb = Workbooks.Open(FolderPath & Filename)
        On Error Goto NextFile 
        Set ws = wb.Worksheets("Trippings_15")
        With ws
            lastRow = .Cells(.Rows.count, 1).End(xlUp).Row
            lastCol = .Cells(1, .Columns.count).End(xlToLeft).Column
            .Range(.Cells(5, 1), .Cells(lastRow, lastCol)).Copy
            Sheet1.Cells(eRow, 1).PasteSpecial xlPasteValues
        End With
NextFile:
        On Error Goto 0
        wb.Close False
        Filename = Dir
    Loop
    Application.DisplayAlerts = True
End Sub

Answer 1

试试这个。这里的逻辑是您预定义将在"Trippings_15"字符串中插入的月份。另外，添加一个函数来测试工作表是否存在，而不是使用笨重的On Error Resume Next

Sub copyDataFromMultipleWorkbooksIntoMaster()

    Dim FolderPath As String, Filepath As String, Filename As String

    '### DEFINE YOUR BASE STRING TO BE UPDATED WITH EACH MONTH
    Dim baseSheetName$
    baseSheetName = "Trippings_{}_15"
    Dim sheetName as String  'This will be updated later...

    '### DEFINE AN ARRAY OF MONTHS 
    Dim months, m
    months = Array("JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC")

    FolderPath = "D:\Copy Multiple Excel to One master\"
    Filepath = FolderPath & "*.xls*"

    Dim lastRow As Long, lastCol As Long, eRow As Long
    Dim wb As Workbook, ws As Worksheet
    Application.DisplayAlerts = False

    Filename = Dir(Filepath)
    Do While Filename <> ""
        eRow = Sheet1.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
        Set wb = Workbooks.Open(FolderPath & Filename)

        For Each m in months  '## Iterate over each month in your array
            sheetName = Replace(baseSheetName,"{}",m)  '## this is the month sheet name like "Trippings_Jan_15", etc.
            If SheetExists(wb, sheetName) Then   '## Check whether this sheet exists before tryingto use it
                Set ws = wb.Worksheets(sheetName)
                With ws
                    lastRow = .Cells(.Rows.count, 1).End(xlUp).Row
                    lastCol = .Cells(1, .Columns.count).End(xlToLeft).Column
                    .Range(.Cells(5, 1), .Cells(lastRow, lastCol)).Copy
                    Sheet1.Cells(eRow, 1).PasteSpecial xlPasteValues
                End With
            End If
        Next m
        wb.Close False
        Filename = Dir
    Loop
    Application.DisplayAlerts = True
End Sub

这是函数SheetExists：

Function SheetExists(wb as Workbook, s as String)
    Dim ws as Worksheet
    Dim ret as Boolean
    For Each ws in wb.Worksheets
        If ws.Name = s Then
            ret = True
            Exit For
        End If
    Next
    SheetExists = ret
End Function

由于工作表名称，导入来自不同工作簿的工作表不起作用？

1 个答案: