簡體   English   中英

將動態范圍復制到新工作表

[英]Copy a dynamic range to a new worksheet

我正在嘗試將動態范圍設置到變量上,以將范圍復制到另一張紙上。

在我得到的最后一行

“運行時錯誤‘91’,Object 變量或未設置塊變量”

其他一切都有效。 找到最后的行和列。

Sub AutoFilter()

Dim shWorkBook As Worksheet
Dim shPivotTable As Worksheet
Dim shCarrierRates As Worksheet
Dim shWholesaleLocation As Worksheet
Dim shPWLocation As Worksheet
Dim wkb As Workbook
Dim shSegmentation As Worksheet
Dim MilageMatrix As Worksheet
Dim FullYearData As Worksheet
Dim StartForm As Worksheet
Set wkb = ThisWorkbook

With wkb
    Set shPivotTable = .Sheets("PivotTable")
    Set shCarrierRates = .Sheets("CarrierRates")
    Set shWholesaleLocation = .Sheets("WholesalerLocation")
    Set shPWLocation = .Sheets("PWLocation")
    Set shSegmentation = .Sheets("Segmentation")
    Set shMilageMatrix = .Sheets("MilageMatrix")
    Set shFullYearData = .Sheets("FullYearData")
    Set shStartForm = .Sheets("StartForm")
    set shWorkBook = .sheets("WorkBook")
End With

Dim DataRange As Range
Dim PWSelection As Integer
Dim LastRow As Long
Dim LastColumn As Long

Set StartCell = shFullYearData.Range("A1")

'Find Last Row and Column
LastRow = shFullYearData.Cells(shFullYearData.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = shFullYearData.Cells(StartCell.Row, shFullYearData.Columns.Count).End(xlToLeft).Column

'Select Range
shFullYearData.Range(StartCell, shFullYearData.Cells(LastRow, LastColumn)).Select
Set DataRange = Selection
PWSelection = shStartForm.Cells(1, 1).Value

shFullYearData.Range(DataRange).Copy Destination:=shWorkBook.Range("A1")

End Sub   

沒有理由找到最后一行和最后一列。 只需使用Range().CurrentRegion

ThisWorkbook.Sheets("FullYearData").Range("A1").CurrentRegion.Copy ThisWorkbook.Sheets("WorkBook").Range("A1")

我強烈建議使用工作表代號,閱讀: VBA CodeNames Explained

試試這個。 但是我注意到您使用 xlup 並在您的起點是單元格 a1 時離開。 我對此有點困惑。 但是我能夠通過運行代碼時彈出的錯誤。

Sub AutoFilter()

Dim shWorkBook As Worksheet
Dim shPivotTable As Worksheet
Dim shCarrierRates As Worksheet
Dim shWholesaleLocation As Worksheet
Dim shPWLocation As Worksheet
Dim wkb As Workbook
Dim shSegmentation As Worksheet
Dim MilageMatrix As Worksheet
Dim FullYearData As Worksheet
Dim StartForm As Worksheet
Set wkb = ThisWorkbook
With wkb

Set shPivotTable = .Sheets("PivotTable")
Set shCarrierRates = .Sheets("CarrierRates")
Set shWholesaleLocation = .Sheets("WholesalerLocation")
Set shPWLocation = .Sheets("PWLocation")
Set shSegmentation = .Sheets("Segmentation")
Set shMilageMatrix = .Sheets("MilageMatrix")
Set shFullYearData = .Sheets("FullYearData")
Set shStartForm = .Sheets("StartForm")

Set shWorkBook = .Sheets("WorkBook")

End With

Dim DataRange As Range
Dim PWSelection As Integer
Dim LastRow As Long
Dim LastColumn As Long


Set StartCell = shFullYearData.Range("A1")

'Find Last Row and Column
    
''I cant figure out why you want to start at a1 and then do xlup and xlleft. that only 
''gets you to a1.
LastRow = shFullYearData.Cells(shFullYearData.Rows.Count, 
StartCell.Column).End(xlUp).Row
LastColumn = shFullYearData.Cells(StartCell.Row, 
shFullYearData.Columns.Count).End(xlToLeft).Column

'Select Range

''**here is where i made a change**
shFullYearData.Select
Range(StartCell, shFullYearData.Cells(LastRow, LastColumn)).Select


Set DataRange = Selection
PWSelection = shStartForm.Cells(1, 1).Value

''**I also made a change here**
shFullYearData.Select
DataRange.Copy Destination:=shWorkBook.Range("A1")

End Sub

我現在懷疑您的代碼模塊頂部沒有Option Explicit 因此,您不會收到關於StartCell缺少聲明的警報。 事實上, StartCell是一個相當無用的范圍,但如果沒有設置它,您的選擇將失敗,這將導致DataRange為 Nothing,盡管此錯誤應該發生在最后一行之前。 當然,選擇也完全沒有必要,它本身可能會導致問題,因為您不控制 ActiveSheet,並且在不活動的工作表上不能有Selection

為了縮短所有這些,我建議您重新編寫代碼的整個結尾。 這段代碼應該可以工作。

Dim DataRange As Range
Dim PWSelection As Integer
Dim LastRow As Long
Dim LastColumn As Long

With shFullYearData
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set DataRange = .Range(.Cells(1, 1), .Cells(.Cells(LastRow, LastColumn)))
End With
Range(DataRange).Copy Destination:=shWorkBook.Cells(1, 1)

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM