要将数据粘贴到输入的最后一行数据上吗?

问题描述 投票:0回答:1

我目前拥有在复制1张纸时可以正常工作并粘贴正确数据的代码,但是现在我希望它从3张不同的纸中提取数据,将每张纸作为一个大数据集粘贴到下一张纸下。以下是我尝试使用的代码,但是在.Range(LastRow)

处停止
Sub PipelineData()

Dim Fname As String
Dim SrcWbk As Workbook
Dim DestWbk As Workbook

Set DestWbk = ThisWorkbook

Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)

On Error Resume Next

Sheets("BID").ShowAllData
Sheets("DELIVERY").ShowAllData
Sheets("Complete or Cancelled").ShowAllData

On Error GoTo 0

SrcWbk.Sheets("BID").Range("A3:AP200").Copy DestWbk.Sheets("Pipeline").Range("A1")

SrcWbk.Sheets("DELIVERY").Range("A3:AP200").Copy DestWbk.Sheets("Pipeline").Range(LastRow)

SrcWbk.Sheets("Complete or Cancelled").Range("A3:AP200").Copy DestWbk.Sheets("Pipeline").Range(LastRow)

SrcWbk.Close False

End Sub
excel vba copy paste
1个回答
0
投票
Sub PipelineData() Dim Fname As String Dim SrcWbk As Workbook Dim DestWbk As Workbook Set DestWbk = ThisWorkbook Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File") If Fname = "False" Then Exit Sub Set SrcWbk = Workbooks.Open(Fname) On Error Resume Next Sheets("BID").ShowAllData Sheets("DELIVERY").ShowAllData Sheets("Complete or Cancelled").ShowAllData On Error GoTo 0 SrcWbk.Sheets("BID").Range("A3:AP200").Copy DestWbk.Sheets("Pipeline").Range("A1") dim lastrow as long with DestWbk.Sheets("Pipeline") lastrow = .cells(.rows.count, 1).end(xlup).row 'Get last row SrcWbk.Sheets("DELIVERY").Range("A3:AP200").Copy .Range("A" & LastRow) lastrow = .cells(.rows.count, 1).end(xlup).row 'Get new last row SrcWbk.Sheets("Complete or Cancelled").Range("A3:AP200").Copy .Range("A" & LastRow) end with SrcWbk.Close False End Sub
© www.soinside.com 2019 - 2024. All rights reserved.