根据日期范围打开、复制和粘贴数据到另一个工作簿



我正在工作的一个VBA项目,其目的是打开,复制和粘贴数据从一个工作簿在一个文件夹中的另一个工作簿在不同的文件夹。我还想使用日期范围选择要打开、复制和粘贴的报表。

我是编码新手,下面是我的代码:它打开,复制和粘贴数据,然而,1. 并非所有数据都被复制。工作表中有一些空白,代码不会在空白单元格之后复制/粘贴任何内容2. 我尝试添加一些代码来使用日期范围选择工作簿,但没有任何工作。有什么想法吗?如有任何帮助,不胜感激。

Sub P_file()
Dim EnterDate As String
Dim Path As String
Dim wb As Workbook
Dim rng As Range
EnterDate = InputBox("Enter File Date")
Path = "C:cparkmonthfile_" & Format(EnterDate, "m_d_yyyy") & ".xlsx"

'Assign value to object variables
Set wb = ThisWorkbook
Set rng = Range("A2")
Workbooks.Open (Path)
Range("A2", Range("A2").End(xlDown).End(xlToRight)).Copy

wb.Activate
rng.PasteSpecial (xlPasteValues)

试试下面的代码。希望这能解决你的两个问题。

Sub Pick_Report()
Dim EnterDate As String
Dim Path As String
Dim WB_Copy As Workbook
Dim WB_Paste As Workbook
Dim Rng_Paste As Range

EnterDate = InputBox("Enter File Date")
Path = "S:ReportsName of Report_" & Format(EnterDate, "m_d_yyyy") & ".xlsx"

'Assign value to object variables
Set WB_Paste = ThisWorkbook
Set Rng_Paste = WB_Paste.Sheets("Sheet1").Range("A2")'Change "Sheet1" to whatever you need it to be

Workbooks.Open (Path)

Set WB_Copy = Workbooks("Name of Report_" & EnterDate)

WB_Copy.Activate
ActiveSheet.UsedRange.Copy

Rng_Paste.PasteSpecial (xlPasteValues)
End Sub

最新更新