从一个工作簿中提取数据并将其粘贴到另一个工作簿中

我在驱动器“D”中有一个excel文件。我想将sheet1中工作簿“raw”中的数据复制到表“BW”中的另一个工作簿“SC”中。

我正在使用下面的代码,从一个工作簿中提取数据并粘贴到另一个。

Sub extract() Dim x As Workbook Dim y As Workbook Dim Val As Variant Dim filename As String Dim LastCell As Range Dim LastRow As Long CopyCol = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X", ",") LR = Cells(Rows.Count, 1).End(xlUp).Row LC = Cells(1, Columns.Count).End(xlToLeft).Column LCell = Selection.SpecialCells(xlCellTypeLastCell).Address LCC = Selection.SpecialCells(xlCellTypeLastCell).Column LCR = Selection.SpecialCells(xlCellTypeLastCell).Row Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies) Set x = Workbooks.Open("D:\Student\Jenny\Raw.xlsx") For Count = 0 To UBound(CopyCol) Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & LCR) If Count = 0 Then Set CopyRange = temp Else Set CopyRange = Union(CopyRange, temp) End If Next CopyRange.Copy y.Sheets("BW").Range("A5").PasteSpecial x.Close End Sub 

这个代码是在工作,但问题是,在我的工作表“sheet1”我有我的数据从A4开始,并希望复制目标工作表“BW”中的数据从A5。 当前的代码,粘贴从A7复制的数据。 我怎样才能修改这样的方式,从A5复制的数据。

任何潜在客户都会有帮助。

Set temp尝试4而不是1

 Set temp = Range(CopyCol(Count) & "1:" & CopyCol(Count) & LCR) 

如何从源表中select特定工作表(工作表结果 )? ?

使用

 With x.Sheets("Result") . . . End With 

要么

x.Sheets("Result"). 或者你正在尝试的东西。

你有许多未使用和未声明的variables。 您的更新代码可能如下所示:

 Option Explicit Sub extract() Dim x As Workbook, y As Workbook Dim temp As Range, CopyRange As Range Dim LR As Long, LC As Long, LCR As Long, Count As Long Dim copycol copycol = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X", ",") LR = Cells(Rows.Count, 1).End(xlUp).Row LC = Cells(1, Columns.Count).End(xlToLeft).Column Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies) Set x = Workbooks.Open("D:\Student\Jenny\Raw.xlsx") With x.Sheets("Result") LCR = .Cells(.Rows.Count, 1).End(xlUp).Row For Count = 0 To UBound(copycol) Set temp = .Range(copycol(Count) & "4:" & copycol(Count) & LCR) If Count = 0 Then Set CopyRange = temp Else Set CopyRange = Union(CopyRange, temp) End If Next CopyRange.Copy y.Sheets("BW").Range("A5").PasteSpecial End With x.Close End Sub