Excel 基于单元格值，标识当前行并将3个工作表中的同一行复制到新工作簿（循环）-VBA

我的数据设置方式如下：

母版纸：
A列：公司名称（第1-100行）
B栏：国旗？是/否（第1-100行）

第二张：
A列：公司名称（第1-100行与母版纸顺序相同）
B-D列：每个公司的数据（每行一个公司的数据）

表3/4与表2相同，只是数据不同

我想做什么：
如果母版图纸上B列的值为“Y”，则对于该行，将同一行从图纸2/3/4复制到新工作簿中

示例：
在母版图纸中，第一行的“Y”值为第6行（因此为公司#6）。我想将第6行从第2/3/4页复制到包含4页的新工作簿中（仅母版页第6行，仅第2/3/4页第6行）

对具有Y值的所有行重复此操作

到目前为止，我掌握的代码是：

Dim wb As Workbook, FileNm As String, LastRow As Long, wbTemp As Workbook, k As Long, currentRow As Long

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set wb = ThisWorkbook


With wb
    LastRow = .Sheets(1).Cells(.Sheets(1).Rows.Count, 1).End(xlUp).Row

End With


For k = 1 To LastRow
    FileNm = wb.Path & "\" & "BOOK" & k & ".xlsx" 'adding the i to number every workbook from 1 to number of rows

    Set wbTemp = Workbooks.Add 'adding a new workbook

        If Worksheets("Master Sheet").Cells(k,2).Value = "Y" Then

           currentRow = Worksheets("Master Sheet").Rows(k) 

    wb.Sheets(1).currentRow.Copy Destination:=wbTemp.Sheets(1).Rows(1)
    wb.Sheets(2).currentRow.Copy Destination:=wbTemp.Sheets(2).Rows(1)
    wb.Sheets(3).currentRow.Copy Destination:=wbTemp.Sheets(3).Rows(1)
    wb.Sheets(4).currentRow.Copy Destination:=wbTemp.Sheets(4).Rows(1)

End If
    wbTemp.SaveAs FileNm
    wbTemp.Close
    Set wbTemp = Nothing
Next k

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

它不起作用了--我猜是因为线路问题

currentRow = Worksheets("Master Sheet).Rows(k) 

但我不知道如何解决这个问题。谢谢你的帮助

---

谢谢。

复制到新电子表格时，需要访问工作表的“行”属性

wb.Sheets(3).Rows(currentRow).Copy Destination:=wbTemp.Sheets(3).Rows(1)

---

复制到新电子表格时，需要访问图纸的“行”属性

wb.Sheets(3).Rows(currentRow).Copy Destination:=wbTemp.Sheets(3).Rows(1)

---

似乎可以在另一个嵌套循环语句中执行此操作。无需创建第二个变量来跟踪您所在的行-您的变量

k

已经完成了这项工作

当然，您需要添加

尺寸j，只要长度

For k = 1 To LastRow
    FileNm = wb.Path & "\" & "BOOK" & k & ".xlsx" 'adding the i to number every workbook from 1 to number of rows

    Set wbTemp = Workbooks.Add 'adding a new workbook
        If Worksheets("Master Sheet").Cells(k, 2).Value = "Y" Then
            For j = 1 To 4
                wb.Sheets(j).Row(k).Copy Destination:=wbTemp.Sheets(j).Rows(1)
            Next j
        End If

    wbTemp.SaveAs FileNm
    wbTemp.Close
    Set wbTemp = Nothing
Next k

似乎可以在另一个嵌套循环语句中执行此操作。无需创建第二个变量来跟踪您所在的行-您的变量
k
已经完成了这项工作

当然，您需要添加
尺寸j，只要长度

For k = 1 To LastRow
    FileNm = wb.Path & "\" & "BOOK" & k & ".xlsx" 'adding the i to number every workbook from 1 to number of rows

    Set wbTemp = Workbooks.Add 'adding a new workbook
        If Worksheets("Master Sheet").Cells(k, 2).Value = "Y" Then
            For j = 1 To 4
                wb.Sheets(j).Row(k).Copy Destination:=wbTemp.Sheets(j).Rows(1)
            Next j
        End If

    wbTemp.SaveAs FileNm
    wbTemp.Close
    Set wbTemp = Nothing
Next k

在@urderboy的大力帮助下，我们达成了以下解决方案：

Dim wb As Workbook, FileNm As String, LastRow As Long, wbTemp As Workbook, k As Long, z As Long

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.SheetsInNewWorkbook = 4 'must add this line for the nested loop to work

Set wb = ThisWorkbook

    With wb
    LastRow = .Sheets(1).Cells(.Sheets(1).Rows.Count, 1).End(xlUp).Row

End With


For k = 1 To LastRow
    FileNm = wb.Path & "\" & "BOOK" & k & ".xlsx" 'adding the k to number every workbook from 1 to number of rows

    Set wbTemp = Workbooks.Add 'adding a new workbook, will add 4 sheets

        If wb.Worksheets("Master Sheet").Cells(k,2).Value = "Y" Then  'have to add "wb."

        For z = 1 To 4

        wb.Sheets(z).Rows(k).Copy Destination:=wbTemp.Sheets(z).Rows(k)

        Next z

End If
    wbTemp.SaveAs FileNm
    wbTemp.Close
    Set wbTemp = Nothing
Next k

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

在@urderboy的大力帮助下，我们达成了以下解决方案：

Dim wb As Workbook, FileNm As String, LastRow As Long, wbTemp As Workbook, k As Long, z As Long

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.SheetsInNewWorkbook = 4 'must add this line for the nested loop to work

Set wb = ThisWorkbook

    With wb
    LastRow = .Sheets(1).Cells(.Sheets(1).Rows.Count, 1).End(xlUp).Row

End With


For k = 1 To LastRow
    FileNm = wb.Path & "\" & "BOOK" & k & ".xlsx" 'adding the k to number every workbook from 1 to number of rows

    Set wbTemp = Workbooks.Add 'adding a new workbook, will add 4 sheets

        If wb.Worksheets("Master Sheet").Cells(k,2).Value = "Y" Then  'have to add "wb."

        For z = 1 To 4

        wb.Sheets(z).Rows(k).Copy Destination:=wbTemp.Sheets(z).Rows(k)

        Next z

End If
    wbTemp.SaveAs FileNm
    wbTemp.Close
    Set wbTemp = Nothing
Next k

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

它是
行（11）
不是
K
您不需要currentRow变量，它已经存储在
K
中。您还可以将您的问题发送到
（“母版页”）。行
？您缺少了一个
“
，它把代码段的其余部分弄乱了为什么是第11行？很抱歉，我只是想理解一下。我添加了“我的坏！谢谢。因为首先，行是数字，列是字母——但在vba中，两者都是给定的数值。当我输入这个时，我意识到你正在使用
k
作为一个变量-尝试隐藏该行并再次运行它-你得到了什么？它是
行（11）
不是
k
你不需要currentRow变量，它已经存储在
k
中。你能把你的问题回复到
（“主控表”）。行
？您缺少了一个
“
，它把代码段的其余部分弄乱了为什么是第11行？很抱歉，我只是想理解一下。我添加了“我的坏！谢谢。因为首先，行是数字，列是字母——但在vba中，两者都是给定的数值。当我输入这个时，我意识到你正在使用
k
作为变量-尝试隐藏该行并再次运行它-你得到了什么？这看起来不错！我现在正在尝试测试它，但是我在“Nest j”行中得到了一个错误——我已经添加了Dim j，所以我不知道是什么导致了这个问题？它说子或函数未定义。您是否正在按原样测试此代码？这需要放在你的代码中，取代你的循环。不，我正在修改它，以包含在代码的其余部分中——我意识到它应该是下一个，而不是嵌套！将立即测试并报告。当它打开新工作簿时，我会收到一个错误（代码也会停止工作）；运行时错误9，下标超出范围。可能是什么原因造成的？当您共享错误时，您需要确切说明哪一行。该错误可能出现在引用范围对象的任何行上。这看起来不错！我现在正在尝试测试它，但是我在“Nest j”行中得到了一个错误——我已经添加了Dim j，所以我不知道是什么导致了这个问题？它说子或函数未定义。您是否正在按原样测试此代码？这需要放在你的代码中，取代你的循环。不，我正在修改它，以包含在代码的其余部分中——我意识到它应该是下一个，而不是嵌套！将立即测试并报告。当它打开新工作簿时，我会收到一个错误（代码也会停止工作）；运行时错误9，下标超出范围。可能是什么原因造成的？当您共享错误时，您需要确切说明哪一行。该错误可能出现在引用范围对象的任何行上