Нахождение адреса диапазона таблицы с использованием vba

Question

Я работаю с таблицей Excel, в которой есть несколько листов с данными в таблицах.Я пытаюсь объединить листы.Я не хочу, чтобы скопированные данные были в таблицах.Я могу найти адрес диапазона таблиц для всех листов, кроме одного, который возвращает адрес $ 1: $ 104.Все остальные ранжируются так: «$ A $ 1: $ J $ 43».Когда я пытаюсь скопировать эту таблицу, используя адрес, который она возвращает, я получаю ошибку времени выполнения «1004».На данный момент код переписывает все таблицы в одном и том же месте, но я буду изменять код для копирования таблиц в разные места на листе назначения.Вот мой код:

  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

Answer 1

Этот забавный диапазон, очевидно, есть.Что вы можете сделать, так это контролировать размер копируемых данных.Если вы можете установить значимое максимальное значение для ширины таблицы, то вы можете ограничить размер следующим образом:

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")

С высотой таблицы также могут происходить забавные вещи, поэтому вы можете захотеть реализоватьэто для другого измерения.Для добавления таблиц вам нужно знать, где находится первая пустая строка:

FirstEmptyRow = trg.Range("B1").SpecialCells(xlCellTypeLastCell).Row + 1
r.Copy Destination:=trg.Cells(FirstEmptyRow, "B")

Для манипулирования листами вам нужно использовать On Error ..., например:

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

Стоит взятьвремя узнать, как работает обработка ошибок в VBA.

И наконец: используйте Option Explicit.Это платит.