(Solved) – extrapolate cell value every 11 rows


What trick can I use to tell the script “OK copy me Range (“E17″) but I also want you to copy me the E28 value, the E39 value and so on, that is the cell value every 11 rows”. One below the other, of course. In the same column. Of course, until it finds values every 11 rows, otherwise as it already does now go to the next file. Which code should I use instead of only “Range (*)” or in which part should I change the structure of the code?

Option Explicit

Sub MergeCode1()
    Dim BaseWks As Worksheet
    Dim rnum As Long
    Dim MySplit As Variant
    Dim Mybook As Workbook
    Dim src1 As Range, src2 As Range, src3 As Range, src4 As Range, src5 As Range, src6 As Range, src7 As Range, src8 As Range, src9 As Range, src10 As Range, src11 As Range
    Dim destrange As Range
    Dim Rcount As Long
    Dim f

    'Add a new workbook with one sheet
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    BaseWks.Range("A1").Font.Size = 36
    BaseWks.Range("A1").Value = "Please Wait"
    rnum = 3

    MyFiles = ""
    Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=0, _
                          FileFilterOption:=0, FileNameFilterStr:="")

    If MyFiles <> "" Then

        MySplit = Split(MyFiles, Chr(13))
        For Each f In MySplit

            Set Mybook = Workbooks.Open(f)
            Set src1 = Mybook.Worksheets(1).Range("C10:C14")
            Set src2 = Mybook.Worksheets(1).Range("A11:A11")
            Set src3 = Mybook.Worksheets(1).Range("A16:A16")
            Set src4 = Mybook.Worksheets(1).Range("C16:C16")
            Set src5 = Mybook.Worksheets(1).Range("D16:D16")
            Set src6 = Mybook.Worksheets(1).Range("E16:E16")
            Set src7 = Mybook.Worksheets(1).Range("D17:D17")
            Set src8 = Mybook.Worksheets(1).Range("E17:E17")
            Set src9 = Mybook.Worksheets(1).Range("D18:D18")
            Set src10 = Mybook.Worksheets(1).Range("D19:D19")
            Set src11 = Mybook.Worksheets(1).Range("D20:D20")
            'max # of rows to be added...
            Rcount = Application.Max(src1.Rows.Count, src2.Rows.Count, src3.Rows.Count, src4.Rows.Count, src5.Rows.Count, src6.Rows.Count, src7.Rows.Count, src8.Rows.Count, src9.Rows.Count, src10.Rows.Count, src11.Rows.Count)

            If rnum   Rcount >= BaseWks.Rows.Count Then
                MsgBox "Sorry there are not enough rows in the sheet"
                Mybook.Close savechanges:=False
                Exit For

                BaseWks.Cells(rnum, "A").Resize(Rcount).Value = f

                BaseWks.Cells(rnum, "B").Resize(src1.Rows.Count, _
                                                src1.Columns.Count).Value = src1.Value
                BaseWks.Cells(rnum, "B").Offset(0, src1.Columns.Count) _
                             .Resize(src1.Rows.Count, src1.Columns.Count).Value = src1.Value

                BaseWks.Cells(rnum, "C").Resize(src2.Rows.Count, _
                                                src2.Columns.Count).Value = src2.Value
                BaseWks.Cells(rnum, "C").Offset(0, src2.Columns.Count) _
                             .Resize(src2.Rows.Count, src2.Columns.Count).Value = src2.Value

                BaseWks.Cells(rnum, "D").Resize(src3.Rows.Count, _
                                                src3.Columns.Count).Value = src3.Value
                BaseWks.Cells(rnum, "D").Offset(0, src3.Columns.Count) _
                             .Resize(src3.Rows.Count, src3.Columns.Count).Value = src3.Value

                BaseWks.Cells(rnum, "E").Resize(src4.Rows.Count, _
                                                src4.Columns.Count).Value = src4.Value
                BaseWks.Cells(rnum, "E").Offset(0, src4.Columns.Count) _
                             .Resize(src4.Rows.Count, src4.Columns.Count).Value = src4.Value

                BaseWks.Cells(rnum, "F").Resize(src5.Rows.Count, _
                                                src5.Columns.Count).Value = src5.Value
                BaseWks.Cells(rnum, "F").Offset(0, src5.Columns.Count) _
                             .Resize(src5.Rows.Count, src5.Columns.Count).Value = src5.Value

                BaseWks.Cells(rnum, "G").Resize(src6.Rows.Count, _
                                                src6.Columns.Count).Value = src6.Value
                BaseWks.Cells(rnum, "G").Offset(0, src6.Columns.Count) _
                             .Resize(src6.Rows.Count, src6.Columns.Count).Value = src6.Value

                BaseWks.Cells(rnum, "H").Resize(src7.Rows.Count, _
                                                src7.Columns.Count).Value = src7.Value
                BaseWks.Cells(rnum, "H").Offset(0, src7.Columns.Count) _
                             .Resize(src7.Rows.Count, src7.Columns.Count).Value = src7.Value

                BaseWks.Cells(rnum, "I").Resize(src8.Rows.Count, _
                                                src8.Columns.Count).Value = src8.Value
                BaseWks.Cells(rnum, "I").Offset(0, src8.Columns.Count) _
                             .Resize(src8.Rows.Count, src8.Columns.Count).Value = src8.Value

                BaseWks.Cells(rnum, "J").Resize(src9.Rows.Count, _
                                                src9.Columns.Count).Value = src9.Value
                BaseWks.Cells(rnum, "J").Offset(0, src9.Columns.Count) _
                             .Resize(src9.Rows.Count, src9.Columns.Count).Value = src9.Value

                BaseWks.Cells(rnum, "K").Resize(src10.Rows.Count, _
                                                src10.Columns.Count).Value = src10.Value
                BaseWks.Cells(rnum, "K").Offset(0, src10.Columns.Count) _
                             .Resize(src10.Rows.Count, src10.Columns.Count).Value = src10.Value

                BaseWks.Cells(rnum, "L").Resize(src11.Rows.Count, _
                                                src11.Columns.Count).Value = src11.Value
                BaseWks.Cells(rnum, "L").Offset(0, src11.Columns.Count) _
                             .Resize(src11.Rows.Count, src11.Columns.Count).Value = src11.Value

                rnum = rnum   Rcount

            End If

            Mybook.Close savechanges:=False
        Next f

    End If

    BaseWks.Range("A1").Value = "Ready"

End Sub


Leave a Reply

Your email address will not be published. Required fields are marked *