如果使用VBA给出文件名和工作表名称,如何从已关闭的文件中复制数据

时间:2016-06-28 07:24:38

标签: vba excel-vba excel

我是VBA的新手。在工作表1中,文件名和工作表名称是从该文件名中给出的(这些文件在文件夹中),工作表名称要将该文件的数据复制到工作表1.我想打开第一个文件并从文件夹中获取该文件将所有列粘贴到“用户列名称”中的工作表1 我试过但没有得到确切的输出....请帮帮我

Data in Sheet 1 SystemConfiguration Expecting output 代码:

{{1}}

先谢谢

1 个答案:

答案 0 :(得分:0)

得到答案...... !!!!!!!

Public Sub CommandButton1_Click()
    Dim wbk As Workbook
    Dim Filename As String
    Dim Path As String
    Dim mainwb As Workbook
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim FileThere As String
    Dim rowCount As Long
     Dim add As Range
     Dim myFilePath As String
      Dim myWorkbook As Workbook
     Workbooks("aaa.xlsm").Activate
       Set wb = ActiveWorkbook
        wb.Sheets("Sheet10").Activate
        LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        LastColumn = ActiveSheet.Range("A" & Columns.Count).End(xlUp).Column

    For i = 2 To LastRow
        ActiveSheet.Cells(i, 1).Select
        Filename1 = Selection.Value
        Sheetname1 = ActiveCell.Offset(0, 1).Value


        Workbooks("aaa.xlsm").Activate

        myFilePath = Sheets("Sheet9").Range("B2").Value & "\" & Filename1
    mySheetname = Sheetname1

    If Dir(myFilePath, vbDirectory) <> vbNullString Then
      MsgBox "File  There!"
      Set myWorkbook = Application.Workbooks.Open(Filename:=myFilePath)
    On Error Resume Next
         myWorkbook.Sheets(CStr(mySheetname)).Activate
    On Error GoTo 0


        ActiveSheet.UsedRange.Rows(1).Copy
         Workbooks("aaa.xlsm").Activate
        'ActiveWorkbook.ActiveSheet
         Set wb = ActiveWorkbook
          Set ws = wb.Sheets("Sheet10")
        For Each cell In ws.Columns(3).Cells
            If IsEmpty(cell) = True Then cell.Select: Exit For
        Next cell
     Set add = Selection
     Selection.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
     rowCount = Selection.Rows.Count
     Range(add, add.Offset(rowCount - 1, 0)).Value = Filename1
     Range(add.Offset(0, 1), add.Offset(rowCount - 1, 1)).Value = Sheetname1
         myWorkbook.Close savechanges:=False

Else
     MsgBox "File Not There!"
End If

    Next i
    End Sub