Как скопировать диапазон ячеек с одного листа на другой vba excel

 

VistaSV30

Пользователь

Сообщений: 70
Регистрация: 21.11.2014

#1

08.10.2015 09:08:51

Добрый день!
Нужно скопировать данные с листа А на лист Б, при этом  не переходя на лист Б
Одну ячейку скопировать получилось. А вот диапазон пока не могу.

Код
Sub Кн_Архив()
Dim Ar As Range

 Set Ar = Worksheets("Б").Range("A1")
  
   Range("А1").Select 
   Selection.Copy
   Range(Ar.Cells(1, 1)).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 

End Sub

Спасибо!

Изменено: VistaSV3008.10.2015 09:10:21

<#0>

 

yoozhik

Пользователь

Сообщений: 239
Регистрация: 01.01.1970

#2

08.10.2015 09:28:52

Код
Sub Кн_Архив()
Dim Ar As Range
 Set Ar = Worksheets("Б").Range("A1")
[A1:B6].Copy Destination:=Ar
End Sub
 

VistaSV30

Пользователь

Сообщений: 70
Регистрация: 21.11.2014

Спасибо, скопировать получилось!
Подскажите еще как скопировать только значения, а не формулы

 

Sanja

Пользователь

Сообщений: 14838
Регистрация: 10.01.2013

#4

08.10.2015 09:43:01

Ну из двух сделайте один макрос. И зачем эти навороты с Set Ar…?

Код
Sub Кн_Архив()
    [A1:B6].Copy
    Worksheets("Б").Range("A1").PasteSpecial Paste:=xlPasteValues
End Sub
'или вариант с CodeName
Sub Кн_Архив()
    [A1:B6].Copy
    Лист2.[A1].PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

Изменено: Sanja08.10.2015 09:47:00

Согласие есть продукт при полном непротивлении сторон.

 

VistaSV30

Пользователь

Сообщений: 70
Регистрация: 21.11.2014

Спасибо, Sanja. Сделал как Вы посоветовали

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

#6

08.10.2015 10:12:52

Ещё вариант в одну строку (можно написать ещё чуть короче)

Код
Sub tt(): Sheets("Į").[a1:b6].Value = [a1:b6].Value: End Sub

Вырезание, перемещение, копирование и вставка ячеек (диапазонов) в VBA Excel. Методы Cut, Copy и PasteSpecial объекта Range, метод Paste объекта Worksheet.

Метод Range.Cut

Range.Cut – это метод, который вырезает объект Range (диапазон ячеек) в буфер обмена или перемещает его в указанное место на рабочем листе.

Синтаксис

Параметры

Параметры Описание
Destination Необязательный параметр. Диапазон ячеек рабочего листа, в который будет вставлен (перемещен) вырезанный объект Range (достаточно указать верхнюю левую ячейку диапазона). Если этот параметр опущен, объект вырезается в буфер обмена.

Для вставки на рабочий лист диапазона ячеек, вырезанного в буфер обмена методом Range.Cut, следует использовать метод Worksheet.Paste.

Метод Range.Copy

Range.Copy – это метод, который копирует объект Range (диапазон ячеек) в буфер обмена или в указанное место на рабочем листе.

Синтаксис

Параметры

Параметры Описание
Destination Необязательный параметр. Диапазон ячеек рабочего листа, в который будет вставлен скопированный объект Range (достаточно указать верхнюю левую ячейку диапазона). Если этот параметр опущен, объект копируется в буфер обмена.

Метод Worksheet.Paste

Worksheet.Paste – это метод, который вставляет содержимое буфера обмена на рабочий лист.

Синтаксис

Worksheet.Paste (Destination, Link)

Метод Worksheet.Paste работает как с диапазонами ячеек, вырезанными в буфер обмена методом Range.Cut, так и скопированными в буфер обмена методом Range.Copy.

Параметры

Параметры Описание
Destination Необязательный параметр. Диапазон (ячейка), указывающий место вставки содержимого буфера обмена. Если этот параметр не указан, используется текущий выделенный объект.
Link Необязательный параметр. Булево значение, которое указывает, устанавливать ли ссылку на источник вставленных данных: True – устанавливать, False – не устанавливать (значение по умолчанию).

В выражении с методом Worksheet.Paste можно указать только один из параметров: или Destination, или Link.

Для вставки из буфера обмена отдельных компонентов скопированных ячеек (значения, форматы, примечания и т.д.), а также для проведения транспонирования и вычислений, используйте метод Range.PasteSpecial (специальная вставка).

Примеры

Вырезание и вставка диапазона одной строкой (перемещение):

Range(«A1:C3»).Cut Range(«E1»)

Вырезание ячеек в буфер обмена и вставка методом ActiveSheet.Paste:

Range(«A1:C3»).Cut

ActiveSheet.Paste Range(«E1»)

Копирование и вставка диапазона одной строкой:

Range(«A18:C20»).Copy Range(«E18»)

Копирование ячеек в буфер обмена и вставка методом ActiveSheet.Paste:

Range(«A18:C20»).Copy

ActiveSheet.Paste Range(«E18»)

Копирование одной ячейки и вставка ее данных во все ячейки заданного диапазона:

Range(«A1»).Copy Range(«B1:D10»)


Есть книга, в которой 10 листов. Нужно скопировать содержимое 8-го листа в 3-й лист.

Я пытался сделать это следующим способом:

Set CurrentWorkbook = ThisWorkbook
Set sheetTemp = CurrentWorkbook.Worksheets(8)

With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
With CurrentWorkbook
     sheetTemp.Copy CurrentWorkbook.Worksheets(3)
End With
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With

Все работает, но вместо записи в 3-й лист оно создает перед третьим листом новый лист. Как сделать так, чтобы при копировании не создавался новый лист и записывалось в существующий лист?

vikttur_Stop_RU_war_in_UA's user avatar

задан 21 сен 2018 в 10:35

Leksor's user avatar

2

Полное копирование столбцов (ширина, форматирование, значения, примечания…):

Sub CopyRange()
    Worksheets("Лист1").Columns("C:E").Copy
    Worksheets("Лист2").Columns("C:E").PasteSpecial
End Sub

или

Sub CopyRange()
    Worksheets("Лист1").Columns("C:E").Copy Worksheets("Лист2").Columns("C:E")
End Sub

Для копирования только нужного:

  Worksheets("Лист1").Range("C3:E50").Copy

  With Worksheets("Лист2").Range("C3")
      .PasteSpecial xlPasteColumnWidths ' ширина столбца'
      .PasteSpecial xlPasteValues' значения'
      .PasteSpecial xlPasteFormats' форматы'
      .PasteSpecial xlPasteFormulasAndNumberFormats ' формулы'
      ' .....'
  End With

После копирования очистить буфер:

Application.CutCopyMode = False

ответ дан 21 сен 2018 в 11:38

vikttur_Stop_RU_war_in_UA's user avatar

Home / VBA / VBA Copy Range to Another Sheet + Workbook

To copy a cell or a range of cells to another worksheet you need to use the VBA’s “Copy” method. In this method, you need to define the range or the cell using the range object that you wish to copy and then define another worksheet along with the range where you want to paste it.

Copy a Cell or Range to Another Worksheet

Range("A1").Copy Worksheets("Sheet2").Range("A1")
  1. First, define the range or the cell that you want to copy.
    1-define-the-range-or-cell
  2. Next, type a dot (.) and select the copy method from the list of properties and methods.
    2-type-a-dot-and-select-the-copy-method
  3. Here you’ll get an intellisense to define the destination of the cell copied.
    3-define-the-destination-of-the-copied-cell
  4. From here, you need to define the worksheet and then the destination range.
    4-define-the-worksheet-and-than-destination-range

Now when you run this code, it will copy cell A1 from the active sheet to the “Sheet2”. There’s one thing that you need to take care that when you copy a cell and paste it to a destination it also pastes the formatting there.

But if you simply want to copy the value from a cell and paste it into the different worksheets, consider the following code.

Worksheets("Sheet2").Range("A1") = Range("A1").Value

This method doesn’t use the copy method but simply adds value to the destination worksheet using an equal sign and using the value property with the source cell.

Copy Cell from a Different Worksheet

Now let’s say you want to copy a cell from a worksheet that is not active at the time. In this case, you need to define the worksheet with the source cell. Just like the following code.

Worksheets("sheet1").Range("A1").Copy Worksheets("Sheet2").Range("A1")

Copy a Range of Cells

Range("A1:A10").Copy Worksheets("Sheet2").Range("A1:A10")
Range("A1:A10").Copy Worksheets("Sheet2").Range("A1")

Copy a Cell to a Worksheet in Another Workbook

When workbooks are open but not saved yet.

Workbooks("Book1").Worksheets("Sheet1").Range("A1").Copy _
Workbooks("Book2").Worksheets("Sheet1").Range("A1")

When workbooks are open and saved.

Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Copy _
Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1")

Copy a Cell to a Worksheet in Another Workbook which is Closed

'to open the workbook that is saved in a folder on your system _
change the path according to the location you have in your _
system
Workbooks.Open "C:UsersDellDesktopmyFile.xlsx"

'copies cell from the book1 workbook and copy and paste _
it to the workbook myFile
Workbooks("Book1").Worksheets("Sheet1").Range("A1").Copy _
Workbooks("myFile").Worksheets("Sheet1").Range("A1")

'close the workbook and after saving
Workbooks("myFile").Close SaveChanges:=True

Related: How to Open a Workbook using VBA in Excel

More Tutorials

    • Count Rows using VBA in Excel
    • Excel VBA Font (Color, Size, Type, and Bold)
    • Excel VBA Hide and Unhide a Column or a Row
    • Excel VBA Range – Working with Range and Cells in VBA
    • Apply Borders on a Cell using VBA in Excel
    • Find Last Row, Column, and Cell using VBA in Excel
    • Insert a Row using VBA in Excel
    • Merge Cells in Excel using a VBA Code
    • Select a Range/Cell using VBA in Excel
    • SELECT ALL the Cells in a Worksheet using a VBA Code
    • ActiveCell in VBA in Excel
    • Special Cells Method in VBA in Excel
    • UsedRange Property in VBA in Excel
    • VBA AutoFit (Rows, Column, or the Entire Worksheet)
    • VBA ClearContents (from a Cell, Range, or Entire Worksheet)
    • VBA Enter Value in a Cell (Set, Get and Change)
    • VBA Insert Column (Single and Multiple)
    • VBA Named Range | (Static + from Selection + Dynamic)
    • VBA Range Offset
    • VBA Sort Range | (Descending, Multiple Columns, Sort Orientation
    • VBA Wrap Text (Cell, Range, and Entire Worksheet)
    • VBA Check IF a Cell is Empty + Multiple Cells

    ⇠ Back to What is VBA in Excel

    Helpful Links – Developer Tab – Visual Basic Editor – Run a Macro – Personal Macro Workbook – Excel Macro Recorder – VBA Interview Questions – VBA Codes

    На чтение 3 мин. Просмотров 51.7k.

    Итог: Изучите 3 различных способа копирования и вставки ячеек или диапазонов в Excel с помощью макросов VBA. Это серия из трех частей, также вы сможете скачать файл, содержащий код.

    Уровень мастерства: Начинающий

    Копировать и вставить: наиболее распространенное действие Excel

    Копирование и вставка, вероятно, является одним из самых
    распространенных действий в Excel. Это также одна из самых распространенных
    задач, которые мы автоматизируем при написании макросов.

    Есть несколько различных способов выполнить эту задачу, и устройство записи макросов не всегда дает вам наиболее эффективный код VBA.

    В следующих трех видео я объясняю:

    • Самый эффективный метод для простого копирования
      и вставки в VBA.
    • Самый простой способ вставить значения.
    • Как использовать метод PasteSpecial для других
      типов вставок.

    Видео № 1: Простой метод «Копировать-вставить»

    Видео лучше всего просматривать в полноэкранном HD.

    Sub Примеры_копирования_диапазона()
    'Используйте метод Range.Copy для простого копирования / вставки
    
        'Метод Range.Copy - копирование и вставка с 1 строкой
        Range("A1").Copy Range("C1")
        Range("A1:A3").Copy Range("D1:D3")
        Range("A1:A3").Copy Range("D1")
        
        'Range.Copy с одного листа на другой
        Worksheets("Лист1").Range("A1").Copy Worksheets("Лист2").Range("A1")
        
        'Range.Copy с одного файла (на другой
        Workbooks("План.xlsx").Worksheets("Лист1").Range("A1").Copy _
            Workbooks("Факт.xlsx").Worksheets("Лист1").Range("A1")
    
    End Sub
    

    Видео № 2: Простой способ вставить значения

    Sub Копируем_только_значения()
    'Установите значения ячеек равными другим, чтобы вставить значения
    
    'Устанавливает равенство одного диапазона другому
        Range("C1").Value = Range("A1").Value
        Range("D1:D3").Value = Range("A1:A3").Value
         
    'Равенство значений между листами
        Worksheets("Лист1").Range("A1").Value = Worksheets("Лист2").Range("A1").Value
         
    'Равенство значений между книгами
        Workbooks("Факт.xlsx").Worksheets("Лист1").Range("A1").Value = _
            Workbooks("План.xlsx").Worksheets("Лист1").Range("A1").Value
            
    End Sub
    

    Видео № 3: Метод PasteSpecial

    Sub Копируем_с_помощью_специальной_вставки()
    'Используйте метод Range.PasteSpecial для выбора типа вставки
    
     'Копируем и вставляем через СпецВставку
    Range("A1").Copy
    Range("A5").PasteSpecial Paste:=xlPasteFormats
    
    'Используем спецвставку между листами
    Worksheets("Лист1").Range("A2").Copy
    Worksheets("Лист2").Range("A2").PasteSpecial Paste:=xlPasteFormulas
    
    'Используем спецвставку между файлами
    Workbooks("План.xlsx").Worksheets("Лист1").Range("A3").Copy
    Workbooks("Факт.xlsx").Worksheets("Лист1").Range("A1").PasteSpecial Paste:=xlPasteFormats
    
    'Убираем "бегающих муравьёв" после копирования (очищаем буфер обмена)
    Application.CutCopyMode = False    
       
    End Sub
    

    Вставить данные ниже последней заполненной строки

    Один из самых распространенных вопросов, которые я получаю о копировании и вставке с помощью VBA: «Как мне вставить данные в конец таблицы? «

    Сначала нужно найти последнюю заполненную строку данных, а затем скопировать и вставить ниже неё.

    Переходите по ссылке, чтобы научиться 3 способам поиска последней заполненной ячейки

    spring4off

    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    1

    Копирование диапазона ячеек из одного листа в другой

    24.10.2015, 10:48. Показов 16153. Ответов 19

    Метки нет (Все метки)


    Студворк — интернет-сервис помощи студентам

    Подскажите не помогу понять как скопировать в определенное место диапазон ячеек по условию например — с Листа 1 столбец А с 6 строки по условию цвета ячейки в Лист 2 столбец G строки 7. Как в данном примере указать Лист 2 столбец G строки 7, застрял здесь

    Visual Basic
    1
    
     iCell.EntireRow.Copy Destination:=.Cells(.Rows.Count, 1).End(xlUp).Offset(1)

    — так копирует в столбец 1 (А)
    со второй строки, если указывать нужный столбец 7 (G) то ошибка — «Размер копирования не соответствует области вставки»
    вот код:

    Visual Basic
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    
    Sub Test()
    Dim iCell As Range, Priznak&, Rng As Range
    Priznak = 3
    Sheets(2).Range("G7:G28").Clear
    With Sheets(1)
        For Each iCell In .Range("A6", .[A6].End(xlDown))
         
            If iCell.Interior.ColorIndex = Priznak Then
                With Sheets(2)
                    iCell.EntireRow.Copy Destination:=.Cells(.Rows.Count, 7).End(xlUp).Offset(1)
                End With
            End If
        Next iCell
    End With
    End Sub



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    24.10.2015, 11:03

    2

    Лучший ответ Сообщение было отмечено Памирыч как решение

    Решение

    Если копируете всю строку целиком (как в примере), то Destination — это либо вся строка, либо ячейка столбца «A»

    Visual Basic
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    
    Private Sub Test()
        Dim iCell As Range, iRow&, iColor&
        iRow = 7: iColor = 3
        
        Worksheets(2).[G7:G28].Clear  'Почему только G28 ?
        
        With Worksheets(1)
             For Each iCell In .Range(.[A6], .[A6].End(xlDown))
                 If iCell.Interior.ColorIndex = iColor Then
                    iCell.EntireRow.Copy Worksheets(2).Rows(iRow)
                    iRow = iRow + 1
                 End If
            Next
        End With
    End Sub



    0



    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    24.10.2015, 11:26

     [ТС]

    3

    Цитата
    Сообщение от pashulka
    Посмотреть сообщение

    orksheets(2).[G7:G28].Clear *’Почему только G28 ?

    потому что только в этот диапазон нужно будет копировать данные

    Добавлено через 7 минут
    Все равно упорно копирует на второй лист в столбец 1 с 6 строки

    Добавлено через 11 минут
    а нужно вставить в с 7 строки столбца G



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    24.10.2015, 11:28

    4

    Не может он копировать начиная с 6, т.к. изначально значение переменной iRow = 7

    Visual Basic
    1
    
    iCell.Resize(, .Columns.Count - 6).Copy Worksheets(2).Cells(iRow, 7)



    1



    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    24.10.2015, 11:31

     [ТС]

    5

    Да, простите ошибся с 7 строки а не с 6



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    24.10.2015, 13:01

    6

    P.S. Если же нужно копировать только ячейки столбца A, а остальные столбцы оставить в покое, то достаточно :

    Visual Basic
    1
    
    iCell.Copy Worksheets(2).Cells(iRow, 7)

    или так (если перенести нужно только значения)

    Visual Basic
    1
    
    Worksheets(2).Cells(iRow, 7) = iCell



    1



    spring4off

    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    24.10.2015, 16:22

     [ТС]

    7

    Еще нюанс, можно ли сразу при копировании указать сортировку по возрастанию?

    Добавлено через 23 минуты

    Visual Basic
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    
    Sub Test()
    Dim iCell As Range, iRow&, iColor&
        iRow = 7
        iColor = 6
       
        Worksheets(2).[G7:G28].Clear
        
        With Worksheets(1)
             For Each iCell In .Range(.[B15], .[B15].End(xlDown))
                 If iCell.Interior.ColorIndex = iColor Then 
                 iCell.Copy Worksheets(2).Cells(iRow, 7)
                    iRow = iRow + 1
                 End If
            Next
            
            Range("G7:G28").Select
            Selection.sort Key1:=Range("G7"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        
        
        End With
        
        
        
    End Sub

    Так не работает.

    Добавлено через 10 минут
    Header:=xlN
    так работает, может есть проще написание?



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    24.10.2015, 17:11

    8

    Если количество копируемых ячеек гарантировано не больше 22, то можно и так :

    Visual Basic
    1
    2
    3
    
    With Worksheets(2).[G7:G28]
         .Sort .Cells(1), xlAscending ', Header:=xlNo
    End With

    Добавлено через 9 минут
    Если гарантии нет, то один из возможных вариантов :

    Visual Basic
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    
    Private Sub Test()
        Dim iCell As Range, iDest As Range, iColor&, iCount&
        iColor = 6
       
        Set iDest = Worksheets(2).[G7]
        iDest.Resize(iDest.End(xlDown).Row - 6).Clear
        
        With Worksheets(1)
             For Each iCell In .Range(.[B15], .[B15].End(xlDown))
                 If iCell.Interior.ColorIndex = iColor Then
                    iCount = iCount + 1: iCell.Copy iDest(iCount)
                 End If
            Next
        End With
                
        iDest.Resize(iCount).Sort iDest, xlAscending ', Header:=xlNo
    End Sub



    1



    spring4off

    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    25.10.2015, 09:51

     [ТС]

    9

    А как указать искать по всему столбцу с учетом пустых ячеек?

    Visual Basic
    1
    
    For Each iCell In .Range(.[A1], .[A1].End(xlDown))

    а то в таком варианте обрабатывает в низ до первой пустой



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    25.10.2015, 10:18

    10

    Visual Basic
    1
    
    .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    Visual Basic
    1
    
    .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))

    Ответ, кстати, наличествует в Вашем первом посте



    1



    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    25.10.2015, 11:39

     [ТС]

    11

    Спасибо! Ух как тяжко

    Добавлено через 41 минуту
    Я наверное устал, еще один вопрос. Как указать если ничего не выделено то конец?

    Добавлено через 3 минуты
    а то ругается на сортировку



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    25.10.2015, 11:50

    12

    Если ориентироваться на пост#8, то

    либо

    перед сортировкой

    Visual Basic
    1
    
    If iCount = 0 Then Exit Sub

    либо

    Visual Basic
    1
    
    If iCount > 0 Then Сортировка



    0



    spring4off

    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    25.10.2015, 12:27

     [ТС]

    13

    Visual Basic
    1
    2
    
    Set iDest = Worksheets(2).[F7:G28]
        iDest.Resize(iDest.End(xlDown).Row - 6).ClearContents

    так можно указать?



    0



    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    25.10.2015, 12:38

    14

    Вы теперь хотите копировать ячейки двух столбцов ?



    0



    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    25.10.2015, 12:42

     [ТС]

    15

    нет очистить этот диапазон перед копированием
    может как было выше ?
    Worksheets(2).[F7:G28].Clear



    0



    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    25.10.2015, 12:54

    16

    Если destination это столбец G, то зачем очищать столбец F ?



    0



    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    25.10.2015, 13:01

     [ТС]

    17

    Подразумевается то что перед копированием в столбец F — в столбце G имеется уже информация и ее надо очистить



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    25.10.2015, 13:07

    18

    Лучший ответ Сообщение было отмечено spring4off как решение

    Решение

    Можно вообще сделать так :

    Visual Basic
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    
    Private Sub Test3()
        Dim iSource As Range, iDest As Range, iCell As Range
        Dim iCount&, iColor&: iColor = 6
       
        With Worksheets(1)
             Set iSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
        End With
        With Worksheets(2)
             Set iDest = .Range(.Cells(7, 6), .Cells(.Rows.Count, 6))
        End With
        
        'Application.ScreenUpdating = False
        
        iDest.Resize(, 2).Clear
        
        For Each iCell In iSource
            If iCell.Interior.ColorIndex = iColor Then
               iCount = iCount + 1: iCell.Copy iDest(iCount)
            End If
        Next
                
        iDest.Sort iDest(1), xlAscending
        
        'Application.ScreenUpdating = True
    End Sub



    1



    0 / 0 / 0

    Регистрация: 12.10.2015

    Сообщений: 24

    25.10.2015, 13:30

     [ТС]

    19

    Вы гений!
    Последний вопрос как указать при копировании не убирать линии в формате ячеек?
    ClearContents очищает данные.



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    25.10.2015, 13:53

    20

    Если в первом листе у ячеек нет границ(линий), а во втором листе они есть и Вы хотите их оставить (а все остальные параметры форматирования — удалить), то границы(линии) можно просто установить заново, после копирования, например, так :

    Visual Basic
    1
    2
    3
    4
    5
    6
    
    If iCount > 0 Then
       With iDest.Resize(iCount) 'Resize(iCount, 2)
            .Sort .Cells(1), xlAscending '.Sort iDest(1), xlAscending
            .Borders.Weight = xlThin
       End With
    End If



    1



    Bottom line: Learn 3 different ways to copy and paste cells or ranges in Excel with VBA Macros.  This is a 3-part video series and you can also download the file that contains the code.

    Skill level: Beginner

    3 Ways to Copy and Paste in Excel with VBA Macros

    Copy & Paste: The Most Common Excel Action

    Copy and paste is probably one of the most common actions you take in Excel.  It’s also one of the most common tasks we automate when writing macros.

    There are a few different ways to accomplish this task, and the macro recorder doesn’t always give you the most efficient VBA code.

    In the following three videos I explain:

    • The most efficient method for a simple copy and paste in VBA.
    • The easiest way to paste values.
    • How to use the PasteSpecial method for other paste types.

    You can download the file I use in these videos below.  The code is also available at the bottom of the page.

    Video #1: The Simple Copy Paste Method

    You can watch the playlist that includes all 3 videos at the top of this page.

    Video #2: An Easy Way to Paste Values

    Video #3: The PasteSpecial Method Explained

    VBA Code for the Copy & Paste Methods

    Download the workbook that contains the code.

    '3 Methods to Copy & Paste with VBA
    'Source: https://www.excelcampus.com/vba/copy-paste-cells-vba-macros/
    'Author: Jon Acampora
    
    Sub Range_Copy_Examples()
    'Use the Range.Copy method for a simple copy/paste
    
        'The Range.Copy Method - Copy & Paste with 1 line
        Range("A1").Copy Range("C1")
        Range("A1:A3").Copy Range("D1:D3")
        Range("A1:A3").Copy Range("D1")
        
        'Range.Copy to other worksheets
        Worksheets("Sheet1").Range("A1").Copy Worksheets("Sheet2").Range("A1")
        
        'Range.Copy to other workbooks
        Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Copy _
            Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1")
    
    End Sub
    
    
    Sub Paste_Values_Examples()
    'Set the cells' values equal to another to paste values
    
        'Set a cell's value equal to another cell's value
        Range("C1").Value = Range("A1").Value
        Range("D1:D3").Value = Range("A1:A3").Value
         
        'Set values between worksheets
        Worksheets("Sheet2").Range("A1").Value = Worksheets("Sheet1").Range("A1").Value
         
        'Set values between workbooks
        Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1").Value = _
            Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value
            
    End Sub
    
    
    Sub PasteSpecial_Examples()
    'Use the Range.PasteSpecial method for other paste types
    
        'Copy and PasteSpecial a Range
        Range("A1").Copy
        Range("A3").PasteSpecial Paste:=xlPasteFormats
        
        'Copy and PasteSpecial a between worksheets
        Worksheets("Sheet1").Range("A2").Copy 
        Worksheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteFormulas
        
        'Copy and PasteSpecial between workbooks
        Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Copy
        Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteFormats
        
        'Disable marching ants around copied range
        Application.CutCopyMode = False
    
    End Sub

    Paste Data Below the Last Used Row

    One of the most common questions I get about copying and pasting with VBA is, how do I paste to the bottom of a range that is constantly changing?  I first want to find the last row of data, then copy & paste below it.

    To answer this question, I created a free training video on how to paste data below the last used row in a sheet with VBA.  Can I send you the video?  Please click the image below to get the video.

    Paste Data Below Last Used Row VBA Free Training

    Free Training on Macros & VBA

    The 3 videos above are from my VBA Pro Course.  If you want to learn more about macros and VBA then checkout my free 3-part video training series.

    I will also send you info on the VBA Pro Course, that will take you from beginner to expert.  Click the link below to get instant access.

    Free Training on Macros & VBA

    Please leave a comment below with any questions.  Thanks!

    Задача состоит в том, чтобы скопировать определенный диапазон текущего листа, открыть другую книгу, и вставить эти скопированные данные в определенную ячейку, сохранить этот файл и закрыть. Ниже приведен код VBA.

    Sub Название_Макроса()
    
    'Выделить диапазон который необходимо скопировать
    Range("A1:F52").Select
    'Скопировать то, что выделено
    Selection.Copy
    ChDir "путь к папке где лежит файл в который необходимо скопировать"
    Workbooks.Open Filename:= "Название файла, который находится в папке, путь к которой указан выше"
    'Выделить начальную ячейку в которую необходимо вставить скопированные данные
    Range("A6").Select
    'Вставить данные
    ActiveSheet.Paste
    'сохранить текущую книгу
    ActiveWorkbook.Save
    'Закрыть книгу
    ActiveWorkbook.Close
    End Sub
    

    Вариант 2: В открывшейся книге запускаем макрос, чтобы он открыл нужную нам книгу, скопировал от туда нужные нам данные и вставил в нашу открытую книгу, закрыв файл из которого эти данные были скопированы

    Sub Название_Макроса2()
    'Открываем файл с которого нужно скопировать данные
    Workbooks.Open Filename:="C:Данные.xlsx"
    
    'Скопировать нужный диапазон в открывшейся книге на листе 1
    Workbooks("Данные.xlsx").Worksheets("Лист1").Range("A16:E16").Copy
    'Активируем нужную нам книгу
    Workbooks("Книга1.xlsm").Activate
    
    'Выделяем и вставляем скопированные данные в ячейку А1
    ActiveWorkbook.Worksheets("Лист1").Range("A1").Select
    ActiveSheet.Paste
    
    'Закрываем книгу откуда мы скопировали данные
    Workbooks("Данные.xlsx").Close
    
    End Sub
    

    Еще пример — Скопировать диапазоны данных из активной открытой книги Excel нескольких листов (в нашем примере 3-х листов) в другую книгу, которая хранится в определенном месте. Данные будут вставлены как значения, плюс будут перенесены форматы ячеек.

    Sub Копируем_листы_в_другую_книгу()
    Dim bookconst As Workbook
    Dim abook As Workbook
    Set abook = ActiveWorkbook 'присваиваем перменную активной книге
    Set bookconst = Workbooks.Open("C:UsersUserDesktop1.xlsx") 'присваиваем перменную книге куда необходимо копировать данные
    
    'переходим в активную книгу откуда необходимо скопировать данные
    abook.Worksheets("Лист1").Activate
    Range("A1:I23").Copy 'копируем определенный диапазон листа, укажите свой диапазон
    bookconst.Worksheets("Лист1").Activate 'активируем лист куда необходимо вставить данные
    Range("A1:I23").Select 'встаем на ячейку А1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    'вставляем только форматы ячеек
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    'второй лист
    abook.Worksheets("Лист2").Activate
    Range("A1:I23").Copy
    bookconst.Worksheets("Лист2").Activate
    Range("A1:I23").Select 'выделяем диапазон
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    'вставляем только форматы ячеек
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    'третий лист
    abook.Worksheets("Лист3").Activate
    Range("A1:I23").Copy
    bookconst.Worksheets("Лист3").Activate
    Range("A1:I23").Select 'выделяем диапазон
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    'вставляем только форматы ячеек
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    'сохранить текущую книгу
    bookconst.Save
    'Закрыть книгу
    bookconst.Close
    abook.Activate
    
    End Sub
    

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

    Спасибо за внимание.

    Понравилась статья? Поделить с друзьями:
  • Как скопировать лист excel с графиками на другой лист
  • Как скопировать диапазон ячеек excel в другую ячейку
  • Как скопировать лист excel много раз
  • Как скопировать действие в excel
  • Как скопировать лист excel без макроса