У меня есть код, показанный ниже, чтобы скопировать неизвестное количество строк (строки иногда до 20 КБ, только столбцы (6)) и вставить его в другую книгу. Но он работает очень медленно: обновление экрана, режимы расчета, включение событий. Без изменений. рад помочь

Sub CopyData()
Dim sh1 As Worksheet
Dim ShData As Worksheet
Dim sh5 As Worksheet
Dim LR As Long
Dim rng As Range
ThisWorkbook.Worksheets("Destnation").Activate
Set ShData = Workbooks("Data.xlsx").Worksheets(2)
Set sh1 = ThisWorkbook.Worksheets("Sheet1")
Set sh5 = ThisWorkbook.Worksheets("Destnation")

LR = ShData.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ShData.Range("A2:A" & LR)
rng.EntireRow.Copy sh5.Range("A2")
sh1.Range("H1").Value = Workbooks("Data.xlsx").Worksheets(2).Name
End Sub

Благодарность

0
Ahmed 15 Ноя 2020 в 17:10

4 ответа

Лучший ответ

Пожалуйста, попробуйте следующий код. Не нужно активировать, выбирать и использовать буфер обмена. Копировать всю строку тоже не нужно. Но он не скопирует формат:

Sub CopyDataCC()
 Dim sh1 As Worksheet, ShData As Worksheet, sh5 As Worksheet
 Dim LR As Long, LCol As Long, arrCopy

 Set ShData = Workbooks("Data.xlsx").Worksheets(2)
 Set sh1 = ThisWorkbook.Worksheets("Sheet1")
 Set sh5 = ThisWorkbook.Worksheets("Destnation")

 LR = ShData.cells(rows.count, 1).End(xlUp).row
 LCol = ShData.cells(2, Columns.count).End(xlToLeft).Column

 arrCopy = ShData.Range("A2", ShData.cells(LR, LCol))
 sh5.Range("A2").Resize(UBound(arrCopy), UBound(arrCopy, 2)).Value = arrCopy
 sh1.Range("H1").Value = Workbooks("Data.xlsx").Worksheets(2).Name
End Sub
1
FaneDuru 15 Ноя 2020 в 14:49

Если вас интересуют только значения, вы можете использовать свойство .Value объекта Range, соответствующим образом изменив размер вставляемого диапазона

Sub CopyData()

    Dim sourceRng  As Range
    Dim sourceSheetName As String
    
    With Workbooks("Data.xlsx").Worksheets(2)
        Set sourceRng = .Range("A2", .Cells(Rows.Count, 1).End(xlUp)) ' set the source range
        sourceSheetName = .Name
    End With
    
    With ThisWorkbook
        .Worksheets("Destnation").Range("A2").Resize(sourceRng.Rows.Count).Value = sourceRng.Value
        .Worksheets("Sheet1").Range("H1").Value = sourceSheetName
    End With
    
End Sub
1
user3598756 15 Ноя 2020 в 17:47

И Fandune, и user3598756 оптимальны, если вас интересуют только значения, что, вероятно, так и есть. Однако вы не указали это в своем сообщении, поэтому я добавлю свой ответ для всех, кому действительно нужно фиксировать формат (возможно, с датой?)

Попробуйте это ниже, а также обратите внимание на комментарии к некоторым частям вашего кода.

Sub CopyData()
'This macro is running from the file where the data is being pasted.


Dim ShData As Worksheet 'this file is presumed to be open
    Set ShData = Workbooks("Data.xlsx").Worksheets(2)
    
Dim sh5 As Worksheet
    Set sh5 = ThisWorkbook.Worksheets("Destnation")

Dim LR As Long 'this will work so long as no rows are hidden
    LR = ShData.Cells(Rows.Count, 1).End(xlUp).Row

Dim rng As Range 'no need to do entire rows. Probably your biggest issue.
    Set rng = ShData.Range("A2:G" & LR)

'copies Data.XLSX sheet 2 to Destination in the file WHERE this macro is being called
rng.Copy sh5.Range("A2")

'Not sure what this is doing other than trying to put a sheet name somewhere where macro is called.
Dim sh1 As Worksheet
    Set sh1 = ThisWorkbook.Worksheets("Sheet1")
    sh1.Range("H1").Value = ShData.Name
End Sub
0
PGSystemTester 15 Ноя 2020 в 18:24

Удалить свойство всей строки из копии и заменить

Set rng =shData.Range(ShData.cells(2,1),ShData.cells(LR,ShData.cells(1,columns.count).xl(toleft).column))

0
Tomasz 15 Ноя 2020 в 14:39