[英]Copying data from one workbook to another
我的要求是將多個工作簿中的前兩頁復制到一個主工作簿中。 我大部分時間都在工作。 第一張表格被正確復制。 執行第二個時,我收到錯誤“應用程序定義或對象定義錯誤”。 我無法找出究竟是什么問題。 任何幫助將非常感激。 這是復制的代碼。 以下代碼之前的任何內容都涉及打開源文件夾,目標工作簿和設置
Set shtDest = ActiveWorkbook.Sheets(1)
Set shtDest2 = ActiveWorkbook.Sheets(2)
Filename = Dir(path & "\*.xlsx", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest2 = shtDest2.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng2.Copy Dest2
Wkb.Close False
End If
Filename = Dir()
Loop
第一組代碼工作正常。 我得到的錯誤是在Set CopyRng2上。 我做錯了什么或者我錯過了什么?
提前致謝
原因很簡單。 Cells
對象未完全限定
Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
您的Sheets(1)
處於活動狀態,因此Cells
對象指的是Sheets(1)
,也是活動Activesheet
應始終完全限定對象。 試試這個代碼
用此替換該行(注意點?)
With Wkb.Sheets(2)
Set CopyRng2 = .Range(.Cells(RowofCopySheet, 1), _
.Cells(.UsedRange.Rows.Count, _
.UsedRange.Columns.Count) _
)
End With
同樣為其他人做。
一個額外的說明。 避免使用UsedRange
。 嘗試找到最后一行和列,然后構建您的范圍。 你可能想看到這個
如果您對代碼感到困惑,則需要指明您希望范圍的工作表。
這是一個簡單的例子,它可能令人困惑,因為你在同一行上引用了工作表和活動工作表。
Set wkb = Workbooks.Open(Filename:=Path & "\" & Filename)
With wkb.Sheets(1)
Set CopyRng = .Range(.Cells(RowofCopySheet, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
End With
With wkb.Sheets(2)
Set CopyRng2 = .Range(Cells(RowofCopySheet, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
End With
With shtDest
Set Dest = .Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End With
With shtDest2
Set Dest2 = .Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End With
CopyRng.Copy Dest
CopyRng2.Copy Dest2
wkb.Close False
End If
我認為問題可能是ActiveSheet。 通常建議避免這種情況並明確表格。 當您嘗試從工作表2復制時,焦點仍然在工作表1上。
嘗試(換行符使其可讀):
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1),
Cells(Wkb.Sheets(1).UsedRange.Rows.Count,
Wkb.Sheets(1).UsedRange.Columns.Count))
我假設沒有指定RowofCopySheet你不想復制整張表?
如果您希望整張工作表將整個工作表復制到Excel 2010中的新工作表,則@brettdj中的此語法可能會起作用
Sub Test()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets(1)
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub
' in your case
' You need to set your destination workbook.
' You could use your code at start but would be better to explicitly name it
set MasterWkb = ActiveWorkbook
...
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set wsCopy = Wkb.Sheets(1)
wsCopy.Copy MasterWkb.Sheets(Sheets.Count)
' i.e. Copy to end of master workbook
問題似乎是您嘗試使用對另一個工作表的引用在一個工作表中設置范圍
Set CopyRng2 = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
在“CopyRng2”的情況下,沖突在“Wkb.Sheets(2)”和活動表之間,在這種情況下似乎是“shtDest”,因為這是發生copypaste的那個。
在第一個副本中也是這種情況,第一個副本沒有錯誤,因為“Wkb.Sheets(1)”也是當時的活動表
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
要消除這種錯誤,請避免使用活動表(如果使用多窗口Excel 2013,則必須使用此類錯誤),始終具體說明您正在使用的對象,使用如下代碼:
With WbkSrc.Worksheets(b)
Set aRngSrc(b) = Range(.Cells(kRowCopyFrom, 1), .UsedRange.SpecialCells(xlLastCell))
End With
在下面找到對原始代碼的一些調整:
我考慮了以下假設:在此過程之前定義了以下變量
kPath
WbkTrg(目標工作簿)
kRowCopyFrom(RowofCopySheet)
還添加了以下常量,以使其靈活處理要復制的工作表數量
Const kWshCnt As Byte = 2
還提供了兩種“粘貼”目標工作表中的值的替代方法(參見下面的選項1和2)
Option Explicit
Option Base 1
Rem Previously defined
Const kPath As String = "D:\!EEM Documents\!Desktop\@Trash\TEST"
Const kRowCopyFrom As Byte = 6
Dim WbkTrg As Workbook
Rem New constant
Const kWshCnt As Byte = 2
Sub Solution_CopyWshsFromAllFilesInFolder()
Dim sFileSrc As String
Dim WbkSrc As Workbook
Dim aRngSrc(kWshCnt) As Range
Dim aRowIni(kWshCnt) As Long
Dim RngTrg As Range
Dim b As Byte
sFileSrc = Dir(kPath & "\*.xlsx", vbNormal)
If Len(sFileSrc) = 0 Then Exit Sub
Do Until sFileSrc = vbNullString
If Not sFileSrc = WbkTrg.Name And Not sFileSrc Like "CopyWshsFromAllFilesInFolder_*" Then
Set RngTrg = Nothing
Set WbkSrc = Workbooks.Open(Filename:=kPath & "\" & sFileSrc)
Rem Validates required number of worksheets in source workbook
If WbkSrc.Worksheets.Count >= kWshCnt Then
For b = 1 To kWshCnt
Rem Sets source range
With WbkSrc.Worksheets(b)
Set aRngSrc(b) = Range(.Cells(kRowCopyFrom, 1), .UsedRange.SpecialCells(xlLastCell))
End With
With WbkTrg.Worksheets(b)
Rem Resets the Starting row to set the values from source ranges
Rem Leaves one row between ranges to ensure no overlapping
If aRowIni(b) = 0 Then aRowIni(b) = kRowCopyFrom Else aRowIni(b) = 2 + .UsedRange.SpecialCells(xlLastCell).Row
Rem Option 1 - Brings only the values from the source ranges
Set RngTrg = Range(.Cells(aRowIni(b), 1), .Cells(-1 + aRowIni(b) + aRngSrc(b).Rows.Count, aRngSrc(b).Columns.Count))
RngTrg.Value = aRngSrc(b).Value2
Rem Option 2 - Paste the values and number formats from the source ranges
Rem This option only uses the starting cell to paste the source ranges
Set RngTrg = .Cells(aRowIni(b), 1)
aRngSrc(b).Copy
RngTrg.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End With: Next: End If
WbkSrc.Close False
End If
sFileSrc = Dir()
Loop
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.