Merge spreadsheets by different row quantity

[snapz]

I have 5 workbooks. We'll call them code1, code2, code3, code4, code5. I need to merge these into one workbook called master. All workbooks only have one sheet named Sheet1. I need to pull 50 records (rows) from code1, 63 records (rows) from code2, 50 records (rows) from code3, 38 records (rows) from code4, 50 records (rows) from code5 and repeat the process until all the records are merged. Is this even possible?

Thanks. TJ

 

[mumps]

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim srcWB As Workbook
    For Each srcWB In Application.Workbooks
        If srcWB.Name <> "Master.xlsm" Then
            LastRow = srcWB.Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            srcWB.Sheets("Sheet1").Rows("2:" & LastRow).EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next srcWB
    Application.ScreenUpdating = True
End Sub

 

[snapz]

I'm not following how you're last piece of code should fit with the previous code. I pasted where I thought it fit and it didn't change anything. Still not looping.

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim srcWB As Workbook
    For Each srcWB In Application.Workbooks
       If srcWB.Name <> "Master.xlsm" Then
          LastRow = srcWB.Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Select Case srcWB.Name
                Case "code1.xlsx", "code3.xlsx", "code5.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:51").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Case "code2.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:64").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Case "code4.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:39").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            End Select
        End If
    Next srcWB
    Application.ScreenUpdating = True
End Sub

 

[snapz]

Still not looping. I pasted the code how where I thought it would go. still only pulls the data one time.

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim srcWB As Workbook
    For Each srcWB In Application.Workbooks
       If srcWB.Name <> "Master.xlsm" Then
          LastRow = srcWB.Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Select Case srcWB.Name
                Case "code1.xlsx", "code3.xlsx", "code5.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:51").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Case "code2.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:64").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Case "code4.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:39").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            End Select
        End If
    Next srcWB
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Have you tried the macro I posted in Post #11 ?

 

[snapz]

I did. I think I have something that will work for me. Since I know mathematically how many times to loop the code I did the following:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook
    Dim i As Integer
    i = 0
    Do Until i = 10
    For Each srcWB In Application.Workbooks
       If srcWB.Name <> "Master.xlsm" Then
            Select Case srcWB.Name
                Case "code1", "code3.xlsx", "code5.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:51").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                    srcWB.Sheets("Sheet1").Rows("2:51").Delete
                Case "code2.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:64").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                    srcWB.Sheets("Sheet1").Rows("2:64").Delete
                Case "code5.xlsx"
                    srcWB.Sheets("Sheet1").Rows("2:39").EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                    srcWB.Sheets("Sheet1").Rows("2:39").Delete
            End Select
        End If
    Next srcWB
    i = i + 1
    Debug.Print i
    Loop
    Application.ScreenUpdating = True
End Sub

Thoughts??