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。付钱。

使用VBA查找表范围的地址

1 个答案: