파일 이름과 시트 이름이 주어진 경우 닫힌 파일의 데이터를 복사하는 방법 VBA 사용

Question

VBA를 처음 사용합니다. 시트 1에서 파일 이름과 시트 이름이 주어진 파일 이름 (이 파일들은 폴더에 있음)과 시트 이름은 해당 파일의 데이터를 시트 1에 복사하려고합니다. 첫 번째 파일을 열고 폴더에서 파일을 가져오고 싶습니다. "사용자 열 이름"내가 시도 에 시트 1에 모든 열을 붙여하지만 정확한 출력을받지는 ....

나에게 도와주세요 코드 : 사전에

Public Sub CommandButton1_Click() 
    'DECLARE AND SET VARIABLES 
    Dim wbk As Workbook 
    Dim Filename As String 
    Dim Path As String 
    Dim mainwb As Workbook 
    Dim ws As Worksheet 
    Dim search_result As Range 'range search result 
     Dim blank_cell As Long 
    Dim wb As Workbook 
    Dim rowCount As Long 
    Dim add As Range 
    Workbooks("abc.xlsm").Activate 
     Set wb = ActiveWorkbook 
     wb.Sheets("Sheet 1").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("abc.xlsm").Activate 
     input_directory = Sheets("SystemConfiguration").Range("B2").Value & "\" 
     Filename = Dir(input_directory & "*.xls") 
     Workbooks("abc.xlsm").Activate 
     'Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN 
     Set wbk = Workbooks.Open(input_directory & Filename) 
     Set wbk = ActiveWorkbook 
     variable = ActiveSheet.Name 
     If variable = Sheetname1 & Filename = Filename1 Then 
      GoTo PROC 
     End If 
     ActiveSheet.UsedRange.Rows(1).Copy 
     Workbooks("abc.xlsm").Activate 
     'ActiveWorkbook.ActiveSheet 
     Set wb = ActiveWorkbook 
      Set ws = wb.Sheets("Sheet2") 
     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 = Filename 
    Range(add.Offset(0, 1), add.Offset(rowCount - 1, 1)).Value = variable 
     wbk.Close savechanges:=False 
     Filename = Dir 
    'Loop 
    PROC: 
    Next i 
    End Sub 

감사합니다

Answer 1

답을 얻었습니다 ... !!!!!!!

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