Copy data from a worksheet to another stepping by 6

Question

I have a bit of problem : I have 3 worksheets:

 - a.xlsm, 
 - b.xlsm 
 - c.xlsm.

The worksheets have only 1 sheet (Sheet1) .The 3 worksheets are fixed and do not change. i really want to copy the cells from

a.xlsm- F1, L1, S1, W1 (jumping by 6 cells) to b.xlsm-column H- H1, H2, H3, H4 and from a.xlsm- F2, L2, S2, W2 to copy in C.xlsm- column H- H1, H2, H3, H4.

Any help is welcomed. Thank you.

Sub TestCopyData()

Dim WbA As Workbook
Dim WbB As Workbook

Set WbA = ActiveWorkbook
Set WbB = "\\hofs\Mike1.xlsm"

Dim SheetA As Worksheet
Dim SheetB As Worksheet

SheetA = WbA.Sheets("Sheet1")
SheetB = WbB.Sheets("Sheet1")

Dim RowA As Integer
Dim LastRowA As Integer

LastRowA = SheetA.Cells(SheetA.Rows.Count, 1).End(xlUp).Row

Dim ColA As Integer
Dim LastColA As Integer

LastColA = SheetA.Cells(1, SheetA.Columns.Count).End(xlToLeft).Column

If StrComp(Sheets("SheetA").Cells(AA, 1).Value, Sheets("SheetB").Cells(A, 1).Value) = 0 Then

For RowA = 1 To LastRowA
    For ColA = 1 To LastColA
        SheetB.Cells(ColA, "W").Value = SheetA.Cells(Row, (ColA * 6)).Value
    Next ColA
Next Row

Else: Exit Sub

End Sub

i made some test with the code below in witch i put all the dates of the year one by one an if filter found it will copy a cell to the worksheet that i need but it doesn't work to good.

Sub FetchData3()
Sheets("Sheet3").Select
    Sheets("Sheet2").Range("A1:I50000").AdvancedFilter Action:= _
    xlFilterCopy, CriteriaRange:=Range("J1:J2"), CopyToRange:=Range("A1:I1"), _
    Unique:=False

End Sub

Did You Try any Code? If not try. If already tried please add the issue details along with piece of code — Siva
Did you mean x1 instead of w1? otherwise this won't be 6 cells.... — Kathara
Hi, Thank you for you interest. I have added 2 pictures on how it looks right now. Some columns will be deleted but is the principal idea. I will add some code in a moment. — wittman

Kathara Kathara · Accepted Answer · 2016-01-28T10:29:03

I had some time, so I made a code which you can use as a start, but you'll have to add more data:

Sub TestCopyData()

    Dim WbA As Workbook
    Dim WbB As Workbook
    Dim WbC As Workbook

    Set WbA = "a.xlsm" 'you'll need to open it or define it for each workbook
    Set WbB = "b.xlsm"
    Set WbC = "c.xlsm"

    Dim SheetA As Worksheet
    Dim SheetB As Worksheet
    Dim SheetC As Worksheet

    SheetA = WbA.Sheets("Sheet1")
    SheetB = WbB.Sheets("Sheet1")
    SheetC = WbC.Sheets("Sheet1")

    Dim RowA As Integer
    Dim LastRowA As Integer

    LastRowA = SheetA.Cells(SheetA.Rows.Count, 1).End(xlUp).Row

    Dim ColA As Integer
    Dim LastColA As Integer

    LastColA = SheetA.Cells(1, SheetA.Columns.Count).End(xlToLeft).Column

    For RowA = 1 To LastRowA
        For ColA = 1 To LastColA
            SheetB.Cells(ColA, "H").Value = SheetA.Cells(Row, (ColA * 6)).Value
        Next ColA
    Next Row

End Sub

This is not tested and it's really an exception that someone just writes you a code here, just so you know....

Copy data from a worksheet to another stepping by 6

1 Answers