Чтобы вставить данные в последней строке данных ввода? - PullRequest
0 голосов
/ 17 марта 2020

В настоящее время у меня есть код, который отлично работает и вставляет правильные данные при копировании 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

1 Ответ

0 голосов
/ 17 марта 2020
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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...