我在两个不同的变量中设置了两个范围。尝试将一个插入表格,然后将另一个插入表格下方。在插入之前,我需要它删除表的数据主体(而不是删除表)。然后我需要插入范围。
当前存在的问题:
获取错误方法'删除对象'_worksheet有时会失败 删除图纸(如果已存在)时首次运行。错误 似乎没有第二次运行。
将NewData复制到表仅插入rng1的第一行。我需要 到复制到表的整个范围,不包括其中值是“ N”的行 A列。如何将整个范围复制到表格中?
Option Explicit
Sub AddDataRow(tableName As String, NewData As Range)
Dim sheet As Worksheet
Dim table As ListObject
Dim col As Integer
Dim lastRow As Range
Set sheet = Range(tableName).Parent
Set table = sheet.ListObjects.Item(tableName)
'First check if the last table row is empty; if not, add a row
If table.ListRows.Count > 0 Then
Set lastRow = table.ListRows(table.ListRows.Count).Range
If Application.CountBlank(lastRow) < lastRow.Columns.Count Then
table.ListRows.Add
End If
End If
'Copy NewData to new table record
Set lastRow = table.ListRows(table.ListRows.Count).Range
lastRow.Value = NewData.Value
End Sub
Sub CopyToDataset()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim destWkb As Workbook
Dim sh As Worksheet
Dim destSh As Worksheet
Dim destSh1 As Worksheet
Dim destSh2 As Worksheet
Dim cell As Range, rng1 As Range, rng2 As Range, row As Range
Dim copyRng As Range
Dim LastRowDestSh1 As Long
Dim LastRowDestSh2 As Long
Dim LastRowDestSh As Long
Dim myTable As ListObject
Dim oNewRow As ListRow
'set source variables
Const startRow As Long = 6
Set ws1 = Sheet1 'worksheet "A Jobs"
Set ws2 = Sheet2 'worksheet "ACC Job Schedule"
Set destWkb = Workbooks("Job Income Summary Export.xlsm")
Set destSh = destWkb.Worksheets("Dataset")
'delete worksheets if they already exists in destination workbook
For Each sh In destWkb.Worksheets
If (sh.Name = ws1.Name Or sh.Name = ws2.Name) And sh.Name <> destSh.Name _
Then
sh.Delete '**getting error method 'Delete of object '_worksheet failed sometimes on first run
End If
Next sh
'copy source worksheets into destination workbook
ws1.Copy After:=destWkb.Sheets(destWkb.Sheets.Count)
ws2.Copy After:=destWkb.Sheets(destWkb.Sheets.Count)
'destination workbook set variables
Set destSh1 = destWkb.Worksheets("A JOBS")
Set destSh2 = destWkb.Worksheets("ACC Job Schedule")
Set myTable = destSh.ListObjects("desttbl")
'Set oNewRow = myTable.ListRows.Add(AlwaysInsert:=True)
'Find the last non-blank cell in column A(1)
LastRowDestSh1 = destSh1.Cells(Rows.Count, 1).End(xlUp).row
Debug.Print (LastRowDestSh1) 'last row is 406
LastRowDestSh2 = destSh2.Cells(Rows.Count, 1).End(xlUp).row
Debug.Print (LastRowDestSh2) 'last row is 182
LastRowDestSh = lastRow(destSh)
Debug.Print (LastRowDestSh) 'last row is 1
Set rng1 = destSh1.Range("A7:AD7", destSh1.Cells(LastRowDestSh1, 32))
Set rng2 = destSh2.Range("A7:AD7", destSh2.Cells(LastRowDestSh2, 32))
'Clear table contents
With myTable.DataBodyRange
On Error Resume Next
.Rows(1).ClearContents
.Offset(1, 0).Resize(.Rows.Count - 1, _
.Columns.Count).Rows.Delete
On Error GoTo 0
End With
'Copy NewData[rng1 and rng2] NewData to new table record
'If UCase(rng1.Cells(cell.row, "A").Value) = "Y"
AddDataRow "desttbl", [rng1] 'only first row is copying to table.
Application.GoTo destSh.Cells(2, 1)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub