迭代列，打开工作表，然后 Copy/Paste

Question

虽然我最初的问题是关于我的代码中的一段，但我选择询问与我拥有的所有代码相关的问题，因为我不确定我是否还有其他错误（如果不是的话）清楚，我是 VBA 的新手，3 天新）。这5天一直被这个任务迷住了，该睡觉了

代码objective总结： 1- 迭代一列 2- 如果在该列中满足条件，则向 select 个工作簿显示对话框。 3- Copy/Paste 从打开的工作簿到“主页”传播sheet。

叙述：我正在尝试制作一个交互式协作程序，用户可以在其中填充信息（“Weekly Staff Production”sheet，D 列是一个下拉列表）。我想编写一个在以下时间运行的宏：

D 列满足条件（单元格的值 =“协调问题”）
满足条件时，系统会提示用户 select 工作簿（prmpt() 例程）
打开一个对话框，他们select这些工作簿
要复制的值的数据在一个 sheet 上，它在所有打开的工作簿中都有一个通用名称（即“计算的分段时间”）。我想从所有这些 sheet 中复制一定范围 (A14:U54) 并将它们粘贴到 ThisWorkbook 中。粘贴总是出现在最后使用的单元格下方（也许如果我们在中间留一行有助于提高可读性）

对于如此冗长的解释，我深表歉意，感谢所有的帮助。作为参考，我已将文件 here 放入，它们包含： 1- 目标工作簿（数据将复制到的位置） 2- 源工作簿（从中复制数据）

下面也是代码，但是，它并没有反映我想做的所有事情（上面列出的）。

Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range

If Not Intersect(Target, Me.Columns("D")) Is Nothing Then
    For Each Cell In Intersect(Target, Me.Columns("D"))
        If Cell.Value = "Coord Issue" Then Call prmpt
    Next Cell


   End If
End Sub
Sub prmpt()
Dim issue_asset As Integer
issue_asset = Cells(ActiveCell.Row, 2).Value
msgbox ("Select intersections affected by " & issue_asset), vbInformation, "Hossam"
Dim i As Integer
Dim filename As Variant
Dim filenamestr As Variant
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim lastRow As Integer

lastRow = 1

'Opening File dialog box

With Application.FileDialog(msoFileDialogFilePicker)

'Enabling multiple files select
.AllowMultiSelect = True
.Filters.Clear

'Only Excel files can be selected
.Filters.Add "Excel Files", "*.xls*"

If .Show = True Then
    For i = 1 To .SelectedItems.Count
        'to record a list of the opened files
        'Opening selected file
        'For Each filename In .SelectedItems
       ' MsgBox filename
        'Next
        'For Each filename In .SelectedItems
            'Find the last used row in both sheets and copy and paste data below existing data.
            
            filenamestr = .SelectedItems(i)
              'Set variables for copy and destination sheets
              Set wsCopy = Workbooks(filenamestr).Worksheets("Sheet4") 'testing with the raw data sheet, eventually this will be the calculated split times sheet
              
              Set wsDest = ThisWorkbook.Worksheets("sheet6")
            
              '3. Copy & Paste Data
              wsCopy.Range("A11:U54").Copy _
              wsDest.Range("A" & lastRow)
           'Next filename

        Workbooks.Open .SelectedItems(i)
        filenamestr = .SelectedItems(1)
        lastRow = lastRow + 55
    Next i
End If

End With

Debug.Print (filenamestr) 'testing the whether filenamestr records the paths

End Sub

Answer 1

此类问题（从工作簿到工作簿的复制）已在此处提出和回答了数十次，并且有许多很好的答案可供参考和学习。但这只涉及 objective #4.

Objective #1 可以使用 Worksheet_Change event or the Workbook_SheetChange 事件完成。每次编辑任何单元格 formula/value 时都会触发这些。所以它会在您的用户输入新数据时触发。

如果您有一组特定的 sheet 要监控，请将 Worksheet_Change 脚本放入那些 sheet 的代码模块中。类似于以下内容：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    
    If Not Intersect(Target, Me.Columns("D")) Is Nothing Then
        For Each Cell In Intersect(Target, Me.Columns("D"))
            If Cell.Value = "Coord Issue" Then Call prmpt
        Next Cell
    End If
End Sub

如果您想观察工作簿中每个 sheet 的变化，请将脚本放入工作簿的代码模块中，如下所示：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Cell As Range
    
    If Not Intersect(Target, Sh.Columns("D")) Is Nothing Then
        For Each Cell In Intersect(Target, Sh.Columns("D"))
            If Cell.Value = "Coord Issue" Then Call prmpt
        Next Cell
    End If
End Sub

在我的示例脚本中，我写了 Call prmpt 来引用您已经编写的代码。但是，如果您的 sub prmpt 在调用代码模块中不可用，那将不起作用。 sub prmpt 需要在同一个工作簿中，或者需要像 Call YourOtherWorkbook.prmpt

一样被正确引用

解释我的示例脚本的其他部分： Intersect 可用于通过查看 Intersect 的返回值是否不是 Nothing 来检查更改的单元格是否在列 D 中。如果更改的范围在 D 列中，则返回的范围将是那些单元格，因此不是 Nothing.

然后我们可以通过单元格检查是否有任何新更改的值满足条件来遍历该范围单元格。如果他们符合条件，我们可以调用你写的子。

迭代列，打开工作表，然后 Copy/Paste

Iterate over a column, open worksheet, and Copy/Paste

iteration

excel

vba