I am working with an excel sheet that has a bunch of sheets with data in tables. I am trying to consolidate the sheets. I do not want the copied data to be in tables. I am able to find the tables range address for all the sheets except one, which is retunring an address of $1:$104. All the other ranged are like this "$A$1:$J$43" . When I try to copy this table using the address it returns , I get the runtime error "1004". For now , the code rewrite all the tables in the same place, but I will be changing the code to copy the tables into different places in the destination sheet. Here is my code:
Sub mergeWorksheets()
Dim wrk As Workbook 'Workbook object - Always good to work with
object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
Dim mLastRow As Integer
Dim LastRow As Integer
Dim rngFound As Range
Dim i As Integer
Set wrk = ActiveWorkbook 'Working in active workbook
'We don't want screen updating
Application.ScreenUpdating = False
' would rather not do a loop but using a function to check and delete sheet renders error
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = "Master" Then
Application.DisplayAlerts = False
Sheets("Master").Delete
Application.DisplayAlerts = True
End If
Next Sheet
' Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(Before:=wrk.Worksheets(1))
' Rename the new worksheet
trg.Name = "Master"
'We can start loop
For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Master worksheet)
If sht.Name Like "*Attri*" Then
Debug.Print sht.Name
'Find the last row of the master sheet
Set rngFound = trg.UsedRange.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not rngFound Is Nothing Then
'you found the value - do something
mLastRow = rngFound.Row
Debug.Print "Last row of master " & rngFound.Address, mLastRow
Else
' you didn't find anything becasue sheet is empty - first pass
mLastRow = 0
End If
For Each tbl In sht.ListObjects
'Do something to all the tables...
Debug.Print tbl.Name
Debug.Print tbl.Range.Address
'Put data into the Master worksheet
tbl.Range.Copy Destination:=trg.Range("B1")
Next tbl
' trg.Cells(mLastRow + 1, 1).Value = "Tab Name"
' trg.Cells(mLastRow + 1, 1).Font.Bold = "True"
' trg.Range("A" & mLastRow + 1).Value = sht.Name
Debug.Print "-------"
Else
' Debug.Print "error " & sht.Name & " is missing header "
End If
Next sht
That funny range is obviously there. What you can do is to control the size of the data to be copied. If you can set a meaningful maximum value for table width then you can limit size like this:
const MAXWID = 1000
Dim r As Range
If tbl.Range.Columns.Count > MAXWID Then
Set r = tbl.Range.Resize(, MAXWID)
Else
Set r = tbl.Range
End If
r.Copy Destination:=trg.Range("B1")
Funny things can happen to the height of the table(s), too, so you may want to implement this for the other dimension. For appending the tables you need to know where the first empty row is:
FirstEmptyRow = trg.Range("B1").SpecialCells(xlCellTypeLastCell).Row + 1
r.Copy Destination:=trg.Cells(FirstEmptyRow, "B")
For sheet manipulation you need to use On Error ... like this:
Application.DisplayAlerts = False
On Error Resume Next
Set trg = wrk.Sheets("Master")
If Err.Number = 0 Then ' sheet exists
trg.Usedrange.Delete ' delete all existing data -> have a clean sheet
Else ' sheet doesn't exist, Add new worksheet as the first worksheet
Set trg = wrk.Worksheets.Add(Before:=wrk.Worksheets(1))
If Err.Number <> 0 Then < sheet is not added, handle error...>
trg.Name = "Master"
End If
On Error Goto 0
Application.DisplayAlerts = True
It's worth taking the time to learn how error handling works in VBA.
And finally: use Option Explicit. It pays.