Question

我怎么

从启用了宏的Excel文件所在的路径中打开所有Excel文件
在所有Excel文件中选择名称为b2b的特定工作表
复制所有数据并将其粘贴到宏文件的Sheet1
复制其他打开的Excel文件的每个b2b表的数据并将其粘贴到下一个空单元格中
关闭除启用宏的文件外的所有文件

不完整的宏，仅适用于指定的文件和位置。

Sub Step1OpenCopyPaste()
    Dim oCell As Range
    Dim rowCount As Integer
    ' open the source workbook and select the source sheet

    Workbooks.Open Filename:="\e\Rohit\Others\Rahul.xlsx"

    Sheets("B2B").Select

    ' copy the source range

    With Sheets("B2B")
        rowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(rowCount, 7)).Select
        'Select.range(a7
    End With

    Selection.Copy

    ' select current workbook and paste the values starting at A1

    Windows("Macro.xlsx").Activate    
    Sheets("Sheet1").Select

    '------------------------------------------------
    With Sheets("Sheet1")
        Set oCell = .Cells(.Rows.Count, 1).End(xlUp)
    End With

    oCell.Select
    '------------------------------------------------

    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save


    Workbooks.Open Filename:="\\e\Rohit\Others\Rohit.xlsx"
    Sheets("B2B").Select

    ' copy the source range

    With Sheets("B2B")
        rowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(rowCount, 7)).Select
    End With

    Selection.Copy

    ' select current workbook and paste the values starting at A1

    Windows("Macro.xlsx").Activate 
    Sheets("Sheet1").Select

    '------------------------------------------------
    With Sheets("Sheet1")
        Set oCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With

    oCell.Select
    '------------------------------------------------

    ActiveSheet.Paste 
    Application.CutCopyMode = False  
    ActiveWorkbook.Save

    Dim wb As Workbook

    'Loop through each workbook
    For Each wb In Application.Workbooks
        'Prevent the workbook that contains the
        'code from being closed
        If wb.Name <> ThisWorkbook.Name Then        
            'Close the workbook and don't save changes
            wb.Close SaveChanges:=False
        End If
    Next wb
End Sub

Answer 1

它应该看起来像这样：

Dim Filename As String
Dim lLastRow As Long
Dim wbDst As Workbook, wbSrce As Workbook
Dim wsDst As Worksheet

Set wsDst = ThisWorkbook.Worksheets("Sheet1")
Filename = Dir("C:\Users\You\Documents\Test\*.xksx")

    Do While Filename <> ""
        Set wbSrce = Workbooks.Open(Filename)
        lLastRow = wsDst.UsedRange.Rows.Count + 1
            wbSrce.Sheets("B2B").UsedRange.Copy wsDst.Range("A" & lLastRow)
            wbSrce.Close savechanges:=False
        Filename = Dir
    Loop

打开文件夹中的所有Excel文件并复制特定文件

1 个答案: