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

Question

问题： 在 VBA 中为源工作簿名称创建单元格引用时出现问题。错误 9 下标超出范围。

我正在做的任务？ 前任。我必须将工作簿（主）中的 50 列中的 32 列复制到新工作簿中。我可以编写代码以在新工作簿中按所需顺序复制和粘贴列。

主工作簿是一个注册模板，用于获取人们的信息，并以新名称保存。 我有超过 65 个工作簿（硕士）要复制。我试图在粘贴源工作簿（主）名称的地方进行单元格引用。我知道源工作簿必须打开才能运行 VBA。

我将 icell 作为变量从单元格 B2 中获取该值，在那里我粘贴了工作簿名称，但代码没有运行。

附上代码 任何建议都非常感谢。

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

我有类似的情况，我为您的情况阅读了位于文件夹中的所有文件，您将所有 65 个工作簿保存在一个文件夹中，然后循环阅读每个工作簿，一旦打开第一本书，您将获取信息：

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

如果您在上面看到我的代码，它将获取文件夹的 url，那么我将启动一个逐个文件查看的进程：

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

然后在上面的代码中，我在某些部分将每个文件以 txt 格式，并调用一个包含我要打开的文件的 url 的方法，其余的应该是复制和粘贴所需的内容实际文件，我展示的最终代码是如何保存向用户询问的文件，对于垃圾代码感到抱歉，但我认为您可以设法获取所需的内容。