我是VBA的新手。在工作表1中,文件名和工作表名称是从该文件名中给出的(这些文件在文件夹中),工作表名称要将该文件的数据复制到工作表1.我想打开第一个文件并从文件夹中获取该文件将所有列粘贴到“用户列名称”中的工作表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