Copy, Paste, and Create New Worksheet if Current Worksheet is Full Macro in VBA

[tsdderek17]

Hi guys!

So I got a 2003 Excel file with 25+ full (65536 rows) sheets of data, and I saved it as a 2010 file. Now I need to copy/paste all of that data into a "Master" sheet in the 2010 file. I want to create a macro to do this (because I have to do this for multiple files), and I've managed to make one that will copy paste the data into a "Master" sheet, but the "Master" sheet eventually fills up and the macro stops working. I want to add some kind of command to the macro telling it to create a new worksheet and continue copy/pasting the data into the new worksheet IF the "Master" worksheet reaches more than 984,000 rows (in the code below, if "NextRow" >= 984000). I've tried and tried but have been unable to figure this out so far. Below is the working macro that will copy/paste the data into the "Master" sheet but NOT create a new worksheet when that one is full.


Sub combine_data()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets


If Sht.Name <> "Master" Then
Sht.Select
Range("A1:N65536").Copy
Sheets("Master").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Else
End If
Next Sht
End Sub



Any and all help would be greatly appreciated!

Derek

 

[JoeMo]

Welcome to the board!

This compiles, but I have not tested it so may need some tweaking. Try it on a copy of your workbook.

Sub combine_data()
Dim Sht As Worksheet, mSht As Worksheet
Dim Ct As Long
Ct = 1
Application.ScreenUpdating = False
For Each Sht In ActiveWorkbook.Sheets
    If Not Sht.Name Like "Master*" Then
        If Ct = 1 Then
            Set mSht = Sheets("Master")
        Else
            Set mSht = Sheets("Master " & "(" & Ct & ")")
        End If
        nextrow = mSht.Cells(mSht.Rows.Count, 1).End(xlUp).Row + 1
        If nextrow >= 984000 Then
            Ct = Ct + 1
            mSht.Copy after:=mSht
            Set mSht = ActiveSheet
            mSht.Cells.ClearContents
            nextrow = 1
        End If
        Sht.Range("A1:N65536").Copy mSht.Cells(nextrow, 1)
    End If
Next Sht
Application.ScreenUpdating = True
End Sub