Based on Cell Value, identify current row and copy the same row in 3 worksheets to a new workbook (in a loop) - VBA

Question

The way my data is setup is as follows:

Master Sheet:
Column A: Company Names (rows 1-100)
Column B: Flag? Y/N (rows 1-100)

Sheet2:
Column A: Company Names (rows 1-100 in the same order as Master Sheet)
Columns BD: Data for each company (one company's data per row)

Sheet 3/4 are the same as Sheet2, just different data.

What I'm trying to do:
If on the Master Sheet Column B's value is "Y", then for that row, copy the same row from Sheets 2/3/4 into a new workbook.

Example:
In the Master Sheet, the first row with a "Y" value is row 6 (therefore, company#6). I would like to copy row 6 from sheets 2/3/4 into a new workbook with 4 sheets (Master Sheet row 6 only, Sheet2/3/4 row 6 only).

Repeat for all rows with a Y value.

The code I have so far:

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

It's not working-- my guess is due to the line

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

but I don't know how to work around that. Any help appreciated.

Thank you.

Answer 1

Seems like you can do this inside another nested loop statement. No need to create a second variable to track the row you are on - your variable k already does this.

You will need to add Dim j as Long of course

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

Answer 2

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

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

Answer 3

With much help from @urdearboy, reached this solution:

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