Macro - Copy speciffic columns when value is XClosed

Question

Hello everyone,   

I've been having a problem for a while and seem to be unable to solve it.  
I am now trying to get it done with Macro's but running in new problems.  

Let me briefly explain what I am trying to do:  
I have a worksheet with data and an empty worksheet.  
Now I want the macro to copy certain columns only when a cell in a set column (W) has a specific value.  

I manage to copy all columns when the above statement is true, but I don't want all the columns, I only want certain columns.  

For testing purposes it is still in the same workbook, but eventually the source will be in a different workbook and the macro will have to run and update in a blank/empty workbook whenever that is opened... not sure how I'm going to do that yet but let's go about this bit by bit :D  

I hope someone here can help me out...  

Kind regards,  

Little_Ghost

Demo file. Macro is included in VB Editor.
https://docs.google.com/file/d/0BwR_VDm5MPhmRW9zSlhYanBZQmM/edit?usp=sharing

TrowaD · Answer

Hi Little ghost,

I'm having some trouble checking out your file.
Check out the code below and see if you can work it out.

Sub CopyRows()
Dim lRow As Integer

lRow = Range("W" & Rows.Count).End(xlUp).Row

For Each cell In Range("W2:W" & lRow)
    If cell.Value = "Specific Value" Then
        Range(Range("D" & cell.Row), Range("G" & cell.Row)).Copy _
        Workbooks("Name of your opened Workbook").Sheets("Destination Sheet").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
Next cell
End Sub

Run this code from data sheet.
The code will check column W for a "Specific Value".
When found it will copy column D:G of the same row and paste it to another workbook, which is already opened, at the first available row in column A.
Change the necessary information.

Let me know if more assistance is needed.

Best regards,
Trowa

little_ghost · Answer

Dear Torwa,

Thank you for your reply and sorry for my late reply.
Strange that you can't access the file I uploaded... what happens when you click the link? Anyway, further down this post, I'll put the code I was using.

Your script works but there are a couple of problems I have with it:
1. It copies a range (D-G) but I need it to copy only a few columns (D, F, H, W, AA) and maybe more columns in the future.
2. The script runs in the workbook that has the data in it yet it should run in the blank (destination) workbook (the workbook with the data in it will not be open)

Eventually the macro will have to run whenever the blank/destination workbook is opened and then get it's inout from the source workbook that is closed.

This is the code I was using:


Sub CopyABS()
    Set Source = Sheets("net-wbs")
    Set Destination = Sheets("ABS_only")
    Dim d
    Dim j
    d = 1
    j = 2
    Do Until IsEmpty(Source.Range("W" & j))
    If Source.Range("W" & j) = "CS ABS" Then
    d = d + 1
    Destination.Rows(d).Value = Source.Rows(j).Value
    End If
    j = j + 1
    Loop
End Sub


Keep in mind:
A) it was running on the destination sheet, but still in the same workbook
B) had to be run manually
C) Copied all columns instead of only the ones needed (D, F, H, W, AA)

I hope this is all clear.

Kind regards,

Little_Ghost

TrowaD · Answer

Hi Little Ghost, 

Try this combo: 

Put this code in a module: 
Sub CopyRows() 
Dim lRow As Integer 
Dim dWB As String 

dWB = "Destibook" 'Name of Destination Workbook 
Workbooks.Open Filename:="C:\Documents\Sourcebook.xls" 'Full file path of source WB 

lRow = Sheets("net-wbs").Range("W" & Rows.Count).End(xlUp).Row 

For Each cell In Sheets("net-wbs").Range("W2:W" & lRow) 
    If cell.Value = "CS ABS" Then 
        Workbooks(dWB).Sheets("ABS_only").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("net-wbs").Range("D" & cell.Row).Value 
        Workbooks(dWB).Sheets("ABS_only").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("net-wbs").Range("F" & cell.Row).Value 
        Workbooks(dWB).Sheets("ABS_only").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("net-wbs").Range("H" & cell.Row).Value 
        Workbooks(dWB).Sheets("ABS_only").Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("net-wbs").Range("W" & cell.Row).Value 
        Workbooks(dWB).Sheets("ABS_only").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("net-wbs").Range("AA" & cell.Row).Value 
    End If 
Next cell 

Workbooks("Sourcebook.xls").Close 'Name of source WB 
End Sub

Then put this code in ThisWorkbook: 
Private Sub Workbook_Open() 
Call CopyRows 
End Sub

Adjust the values with green text behind them.

That should do it. 

Best regards, 
Trowa

TrowaD · Answer

Oh and to comment on your uploaded file.

I see three sheets in landscape much like pdf.

When I click on the option to download, then I.E. tells that "the contents cannot be shown in a frame". No idea what it means.

Macro - Copy speciffic columns when value is X

4 replies

Subscribe To Our Newsletter!