Transferring part of data from one workbook to another

[agafon]

Hello.

Here is my problem : I want to transfer every sixth cell from one workbook into another.
I want it to go this way : starting with A9, then A15 then A21 then A27 etc.
In another workbook all these cells got to find themselves in I column.
So A9 should be in I2, A15 in I3, A21 in I4, A27 in I5 etc.

In both workbooks there is only one worksheet.

Thanks in advance.

 

[Michael M]

Why not simply copy the whole sheet to the other workbook, then delete the unwanted rows by whatever criteria required to get them there in the first instance.
I think it would be much simpler and faster this way.
OR
copy the entire column "A" from one workbook and paste in column "I" in the 2nd workbook, then delete the unwanted

 

[Domenic]

Assuming that both the source and destination workbooks are opened, try...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] CopyEverySixth()

    [color=darkblue]Dim[/color] wksSource [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] Rng [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]

    [color=green]'Change the source workbook name accordingly[/color]
    [color=darkblue]Set[/color] wksSource = Workbooks("Book1.xlsm").Worksheets(1)
    
    [color=green]'Change the destination workbook name accordingly[/color]
    [color=darkblue]Set[/color] wksDest = Workbooks("Book2.xlsm").Worksheets(1)
    
    [color=darkblue]With[/color] wksSource
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        [color=darkblue]For[/color] i = 9 [color=darkblue]To[/color] LastRow [color=darkblue]Step[/color] 6
            [color=darkblue]If[/color] Rng [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                [color=darkblue]Set[/color] Rng = .Cells(i, "A")
            [color=darkblue]Else[/color]
                [color=darkblue]Set[/color] Rng = Union(Rng, .Cells(i, "A"))
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] i
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    Rng.Copy wksDest.Range("I2")
                
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

If Column I in the destination workbook can contain data and you'd like the source data to be copied to the next available row in Column I, replace...

[font=Verdana]Rng.Copy wksDest.Range("I2")
                [/font]

with

[font=Verdana]Rng.Copy wksDest.Cells(wksDest.Rows.Count, "I").End(xlUp)(2)[/font]

 

[agafon]

Thanks, Domenic.

 

[agafon]

Thanks, Domenic.

I got both the source and destination workbooks opened but I get run-time error 9 in this line :
Set wksSource = Workbooks("Book1.xlsm").Worksheets(1)

I changed the source and destination worbooks names accordingly.
What can be wrong with this code ?

 

[Domenic]

Make sure that the workbook name is spelled correctly and that it does not contain an extra space somewhere. Also, if the source workbook has not already been saved, you'll need to omit the file extension. You'll need to use "Book1", not "Book1.xlsm".

 

[agafon]

It works OK now.

Big thanks !!

 

[Domenic]

You're very welcome! Thanks for the feedback!