Question

目前，下面的代码会将两个电子表格复制到宏表中。

问题：我想使用Excel单元格指定文件路径（来自单元格A1，A2或任何地方），工作表名称（来自单元格B1，B2）和相应的指定单元格范围（单元格C1，C2中）而不必使用应用程序浏览到每个文件。

Option Explicit

Sub Sample()
Dim wb1 As Workbook: Set wb1 = ThisWorkbook
Dim wb2 As Workbook
Dim i As Long
Dim wsNew As Worksheet
Dim ws As Worksheet: Set ws = wb1.Sheets("Sheet1")
Dim LastRow
Dim sheetName As String
Dim rangeStart As String
Dim rangeEnd As String
Dim ws2 As Worksheet
Dim CellValueToCopy As String
'declare and set your worksheet with your filenames
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data by finding the last item in Column A

For i = 2 To LastRow 'loop from Row 2 to Last in Sheet1 of this workbook
    Set wb2 = Workbooks.Open(ws.Cells(i, "A")) 'open the file stored in Column A of Sheet1 of this workbook
    sheetName = ws.Cells(i, "B")
    rangeStart = ws.Cells(i, "C")
    rangeEnd = ws.Cells(i, "D")
       'wb2.Sheets(ws.Cells(i, "B").Value).range(ws.Cells(i, "C").Value).Copy
    Set ws2 = wb2.Worksheets(sheetName)
    wb1.Sheets.Add
    wb1.ActiveSheet.Name = sheetName + "_added"
    ' the below is a proof of concept to copy the values
    ' loop through the range rather than just one cell to get the final copy
    CellValueToCopy = ws2.Cells(1, 1)
    wb1.ActiveSheet.Cells(1, 1) = CellValueToCopy
    ' close workbook and reset variables
    wb2.Close SaveChanges:=False
    Set wb2 = Nothing
    Set wsNew = Nothing
    Set ws2 = Nothing
Next i

End Sub

Answer 1

如下所示，这将循环遍历列A，打开给定的文件名，并从列B中的Sheet中复制Column C中的Range并粘贴到当前工作簿中的新工作表中：

Option Explicit

Sub Sample()
    Dim wb1 As Workbook: Set wb1 = Workbooks("Change from interface to Cell specify range.xlsm")
    Dim wb2 As Workbook
    Dim i As Long, LastRow As Long
    Dim wsNew As Worksheet
    Dim ws As Worksheet: Set ws = wb1.Sheets("Sheet1")
    'declare and set your worksheet with your filenames, amend as required
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    'get the last row with data on Column A

    For i = 2 To LastRow 'loop from Row 2 to Last in Sheet1 of this workbook
        Set wb2 = Workbooks.Open(ws.Cells(i, "A")) 'open the file stored in Column A of Sheet1 of this workbook
        wb2.Sheets(ws.Cells(i, "B").Value).Range(ws.Cells(i, "C").Value).Copy
        'above specify the sheet from Column B of Sheet1 and the Range from Column C
        'if you have starting range at Column C and end range at Column D then the line below will copy the specified range
        'wb2.Sheets(ws.Cells(i, "B").Value).Range(ws.Cells(i, "C").Value & ":" & ws.Cells(i, "D").Value).Copy

        Set wsNew = wb1.Sheets.Add(After:=wb1.Sheets(wb1.Sheets.Count))
        wsNew.Name = "Blah Blah " & (i - 1)
        'above add a new sheet and name accordingly, I used the counter i to number the sheets
        wsNew.Range("A1").PasteSpecial xlPasteAll
        wb2.Close SaveChanges:=False
        Set wb2 = Nothing
        Set wsNew = Nothing
    Next i
End Sub

从接口更改为Cell，指定范围

1 个答案: