(Solved) – MergeWorkbooks – the values found at the twenty-first cell away


I have this code. It works correctly, creates a new sheet, copy-pastes the values found in C10, A11, A16, C16, D16, etc in the respective columns. But I need that, without going to the next directory file, I also copy all the values it finds in cell C31, A32, A37, C37, D37 and as well as the values in cell C52, A53, A58, C58, D58 and so on also the values in cell C73, A74, A79, C79, D59. In short, we understood each other: the values found at the twenty-first cell away. As long as there is some value. I tried with a solution but apparently it was not correct. Who can do it?

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")
            Set src3 = Mybook.Worksheets(1).Range("A16")
            Set src4 = Mybook.Worksheets(1).Range("C16")
            Set src5 = Mybook.Worksheets(1).Range("D16")
            Set src6 = Mybook.Worksheets(1).Range("E16")
            Set src7 = Mybook.Worksheets(1).Range("D17")
            Set src8 = Mybook.Worksheets(1).Range("E17")
            Set src9 = Mybook.Worksheets(1).Range("D18")
            Set src10 = Mybook.Worksheets(1).Range("D19")
            Set src11 = Mybook.Worksheets(1).Range("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 *