Looping, and moving Data by criteria to a second workbook

[Hardhat]

I am trying to Loop though a list of a data. For every column where L is left blank,
I need to copy column A:K of that row to a second workbook.

I know in need to make the range to be copied and where it should go on the second workbook dynamic.
But I am struggling with getting to work. Below is a copy what i have done.

Option Explicit

Sub CopyToViewingWB()


Dim RowNum As Long
RowNum = 3


 Workbooks.Open Filename:="M:\HSS Shared Services\Shared Services Team\Chuck T HSS\Recruiting\Req_veiwing_Form.xlsx" 'Location of workbooK
 Workbooks("Req_veiwing_Form.xlsx").Sheets("Master").Range("A2:K1000").ClearContents ' Clear workbook for new content


Do Until Cells(RowNum, 1).Value = "" 'This "Workbook Recruiting Info.xlsm"


    If Sheet1.Cells(RowNum, 12) = "" Then
        Workbooks("Req_veiwing_Form.xlsx").Sheets("Master").Range("A2:K2") = Sheet1.Range("A3:K3").Value 'dynamic range for all Column L's Left emtpy
   End If
   
RowNum = RowNum + 1
Loop


    Workbooks("Req_veiwing_Form.xlsx").Save
    Workbooks("Req_veiwing_Form.xlsx").Close


End Sub

 

[joshman108]

If you're on office 365 and have the latest version, there's a wonderful new formula called FILTER which makes this a lot easier.

On your target workbook, you would just do

=filter(SOURCE_WORKBOOK_RANGE!A:L,L:L="")

on the target sheet, you should just hide column L.

I know this 1) doesn't paste as values and 2) still gives you column L, but this is a newer function I love a lot and want to make sure people know about

 

[JoeMo]

Which workbook & worksheet is the code you show run from?
Are the "blank" cells in col L truly blank or do they have formulas returning ""?
Does the source data have a header row? If so what's the row number?

 

[Hardhat]

Which workbook & worksheet is the code you show run from?
Are the "blank" cells in col L truly blank or do they have formulas returning ""?
Does the source data have a header row? If so what's the row number?

The code is running from the workbook with the L column that can be either filled or blank "Recruiting Info.xlsm"
I would like the columns A:L transfered to the second workbook "Req_veiwing_Form.xlsx" where that is all the data that is needed from the Workbook "Recruiting Info.xlsm"

When the "Recruiting Info.xlsm" is update the person will close the workbook by selection a button at the top that will clear "Req_veiwing_Form.xlsx" then renter all the rows that column L is still empty. I hope this answers you question.

 

[Hardhat]

I like this idea but will also transfer all the data I don't have an issue with the l column being that it just needs to show the rows that L was empty. The end user of the form only want to view that information and not have to do any kind of sorting.

 

[JoeMo]

This is untested so may need some tweaking.

Option Explicit
Sub CopyToViewingWB()
Dim wkshtSource As Worksheet, wbDest As Workbook, c As Range, Rw As Long
Set wkshtSource = ActiveSheet
Set wbDest = Workbooks.Open(Filename:="M:\HSS Shared Services\Shared Services Team\Chuck T HSS\Recruiting\Req_veiwing_Form.xlsx") 'Location of workbooK
wbDest.Sheets("Master").Range("A2:K1000").ClearContents ' Clear workbook for new content
Application.ScreenUpdating = False
With wkshtSource
    On Error Resume Next
    For Each c In Intersect(.UsedRange, .Range("L:L")).SpecialCells(xlCellTypeBlanks)
        If Err.Number <> 0 Then
            MsgBox "No blank cells found in col L - goodbye"
            Exit Sub
        End If
        Rw = Rw + 1
        wbDest.Sheets("Master").Range("A" & Rw + 1, "K" & Rw + 1).Value = .Range("A" & c.Row, "K" & c.Row).Value
    Next c
End With
 With wbDest
    .Save
    .Close
End With
Application.ScreenUpdating = True
End Sub

 

[Hardhat]

JoeMo,

Thank you for the help with this. No Tweeking is needed works like a charm. I am still very new to this and working to learn more every day.

 

[JoeMo]

JoeMo,

Thank you for the help with this. No Tweeking is needed works like a charm. I am still very new to this and working to learn more every day.

You are welcome - thanks for the reply.