VBA 从 Excel 中的另一个工作簿复制数据

Question

Problem: A problem in making a cell reference in VBA for source workbook name. Error 9 subscripts out of range.

Task I am doing? Ex. I have to copy 32 columns out of 50 columns from a workbook(Master) into a new workbook. I am able to make a code to copy and paste the column in the required sequence in new workbook.

The master workbook is a template of a register to take peoples information and it saved with a new name. I have more than 65 workbooks(Master) to copy. I was trying to make a cell reference where I paste the source workbook(Master) name. I am aware that source workbook has to be open will running VBA.

I made icell as variable to fetch that value from cell B2, where I pasted workbook name but code is not running.

Code attached Any suggestion is highly appreciated.

Sub Copy_Paste()
    Dim iCell As String  
    iCell = Workbooks("Crack it").Worksheets("Intro").Range("B2").Value
    'B2 will store the name of source workbook for copying data which will keep on changing 

    Workbooks("iCell").Worksheets("Register").Range("E2:E50").Copy
    Workbooks("Crack it.xlsm").Worksheets("Risk").Range("A2").PasteSpecial Paste:=xlPasteValues 'Refid

    Workbooks("iCell").Worksheets("Register").Range("H2:H50").Copy
    Workbooks("Crack it.xlsm").Worksheets("Risk").Range("B2").PasteSpecial Paste:=xlPasteValues 'Tags

    Workbooks("iCell").Worksheets("Register").Range("A2:A50").Copy
    Workbooks("Crack it.xlsm").Worksheets("Risk").Range("c2").PasteSpecial Paste:=xlPasteValues 'Name

    Workbooks("iCell").Worksheets("Register").Range("Z2:Z50").Copy
    Workbooks("Crack it.xlsm").Worksheets("Risk").Range("D2").PasteSpecial Paste:=xlPasteValues 'Element

    ...... code keeps on repeating till column 32th 
End Sub

Answer 1

I ahve somethign similar, I read all the files located on a folder for your case you will save all the 65 Workbooks in a folder, then read each one of them with a loop, once it takes the first book opened you will take the info:

Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1) & sItem + "\"
    FilePathBox.Value = sItem
End With
NextCode:
GetFolder = sItem & "\"
Set fldr = Nothing

If you see my code above it taks the url of the folder, then I will start a process that will see file by file:

Private Sub UserForm_Activate()
    UserForm1.Top = (Application.Height / 2) - (UserForm1.Height / 2) + 45
    UserForm1.Left = (Application.Width / 2) - (UserForm1.Width / 2) + 200
    UserForm1.Label1.Visible = True
    Label1.Caption = ""
    '-----------------------------------------THIS IS THE LOOP OFR EACH FILE INTO THE FOLDER--------------------------------------------------
    MyPath = UserForm2.FilePathBox.Value
    Dim strFilename As String
    strFilename = Dir(MyPath & "*.txt", vbNormal)
    filesc = 1
    If Len(strFilename) = 0 Then Exit Sub
    Do Until strFilename = ""
        Application.DisplayAlerts = False
        If filesc >= 1 Then
            showBarName.Caption = showBarName.Caption & strFilename
            'Worksheets.Add(Worksheets(Worksheets.Count)).Name = "Data"
            Call ThisWorkbook.XY_Data((UserForm2.FilePathBox.Value & strFilename), (strFilename & ""))
            showBarName.Caption = "Generating XY Data for %PATH%/"
        End If
        filesc = filesc + 1
        counter = counter + cols
        strFilename = Dir()
    Loop
    '------------------------------------------END--------------------------------------------------------------------------------------------
    Worksheets("Spec").Visible = True
    For Each ws In ThisWorkbook.Worksheets
         If ws.Name = "Spec" Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws
    UserForm1.Hide
    showBarName.Caption = "Saving File"
    'THIS IS FOR XLSX
    Application.StatusBar = "Save your file into the PNL Project path."
    Application.DisplayAlerts = False
    Dim hoja As Worksheet
    For Each hoja In Sheets
        If ActiveSheet.Name = "Data" Then
            ActiveWindow.SelectedSheets.Delete
        End If
    Next hoja
    fileSaveName = Application.GetSaveAsFilename( _
    fileFilter:="Excel Workbooks (*.xlsx), *.xlsx")
    If fileSaveName <> False Then
        Application.ActiveWorkbook.SaveAs Filename:=fileSaveName, FileFormat:=51
    End If
    showBarName.Caption = "Generating XY Data for %PATH%/"
    'This is to close the macro without saving
    Application.StatusBar = "XY Data Generated by Yazaki <<erik.floresdelfin@mx.yazaki.com>>"
    'ThisWorkbook.Close savechanges = False
    Application.DisplayAlerts = True
End Sub

Then on the above code in some part I take each file in txt format, and I call a method which contains the url of the file that I want to open, the rest should be taking what tou need to copy and paste on the actual file, the final code I show is how to save the file asking to the user, sorry for the trash code but I think you caould manage taking what you need.