VBA не работает (скопируйте данные из одного файла и вставьте в другую книгу под последней строкой данных) - PullRequest
Новая
       11

VBA не работает (скопируйте данные из одного файла и вставьте в другую книгу под последней строкой данных)

0 голосов
/ 28 февраля 2019

Может кто-нибудь исправить это для меня?Это ломается на стадии вставки.

Sub GetFileCopyLabour()

   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   Dim lDestLastRow As Long

   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)

   lDestLastRow = DestWbk.Sheets("Labour Dump").Cells(DestWbk.Sheets("Labour Dump").Rows.Count, "A").End(xlUp).Offset(1).Row

   SrcWbk.Sheets("DATA DUMP").Range("A:AX").Copy DestWbk.Sheets("Labour Dump").Range("A:AX" & lDestLastRow)
   SrcWbk.Close False

End Sub

Ответы [ 2 ]

0 голосов
/ 05 марта 2019

Итак, вот мой исправленный код, который отлично работает, кроме двух строк, начинающихся после вставки специальных значений.Я пытаюсь получить формулы в ячейках AY2 и AZ2, чтобы скопировать все столбцы для нового диапазона данных, но в настоящее время он делает это только для первой новой строки.Вы знаете, как это исправить?Рассматриваемый код находится в двойных звездочках, которые не являются частью исходного кода!

Sub GetFileCopyLabour () 

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.Calculation = False

Dim Fname как строка Dim SrcWbk как рабочая книга Dim DestWbk как рабочая книга Dim lDestLastRowКак долго 

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)

lDestLastRow = DestWbk.Sheets("Labour Dump").Cells(DestWbk.Sheets("Labour Dump").Rows.Count, "A").End(xlUp).Offset(1).Row

SrcWbk.Sheets("DATA DUMP").Range("A2:AX2000").Copy
DestWbk.Sheets("Labour Dump").Range("A" & lDestLastRow).PasteSpecial xlPasteValues
**DestWbk.Sheets("Labour Dump").Range("AY2:AZ2").Copy
DestWbk.Sheets("Labour Dump").Range("AY2:AZ" & lDestLastRow).FillDown**

SrcWbk.Close False


Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.Calculation = True

End Sub

0 голосов
/ 28 февраля 2019

Это работает для меня: 

Sub GetFileCopyLabour()

    Dim Fname As String
    Dim SrcWbk As Workbook
    Dim DestWbk As Workbook
    Dim lDestLastRow As Long
    Dim SrcWbkLastRow As Long

    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)

    lDestLastRow = DestWbk.Sheets("Labour Dump").Cells(DestWbk.Sheets("Labour Dump").Rows.count, "A").End(xlUp).Offset(1).row
    SrcWbkLastRow = SrcWbk.Sheets("DATA DUMP").Cells.Find(what:="*", After:=SrcWbk.Sheets("DATA DUMP").Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).row

    SrcWbk.Sheets("DATA DUMP").Range("A1:AX" & SrcWbkLastRow).Copy
    DestWbk.Sheets("Labour Dump").Range("A" & lDestLastRow).PasteSpecial

    SrcWbk.Close False

End Sub
...