Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Копирование строк на другой лист с ограничением
 
#1
20.01.2011 14:52:35
Здравствуйте, Уважаемые планетяне!  
Возникла новая потребность и кое , что относительно моей задачи на форуме нашлось.  
Но не совсем то, как надобно в итоге.  
Задача стоит в переносе строк по заполненным ячейкам в определенном столбце.  
Вот он макрос  
Dim i As Long  
   With Sheets("Лист1")  
       For i = 6 To 200 'с 6 по 200 строки в столбце А  
           If Not IsEmpty(.Cells(i, 7)) Then .Cells(i, 7).EntireRow.Copy _  
               Destination:=Sheets("Лист2").Cells(Sheets("Лист2").Cells(Rows.Count, 7).End(xlUp).Row + 1, 1)  
       Next i  
   End With  
   MsgBox "Строки с заполненными ячейками в столбце G перенесены на Лист2", 64, "Конец"  
 
Но он копирует все данные начиная со столбца А и до конца.  
Подскажите как ограничить (и в дальнейшем иметь возможность регулировать)  диапазон копируемых данных  
например осуществлять просмотр и копировать данные со столбца В по L и до последней заполненной ячейке в столбце С   ?  
Примерчик с макросом прикрутила.  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>
 
 
 
#2
20.01.2011 15:08:56
If Not IsEmpty(.Cells(i, 7)) Then .range("B" & i & ":L" & i).Copy _  
 
или  
 
If Not IsEmpty(.Cells(i, 7)) Then Intersect(.Rows(i), .Range("B:L")).Copy _
 
 
 
#3
20.01.2011 15:10:55
во первых вы проверяете не столбец А а столбец G. А что бы перенести нужные данные задайте не всю строку при копировании как сдесь:  
Then .Cells(i, 7).EntireRow.Copy  а нужный диапазон в вашем случае:  
Then .Range(Cells(i, 3), Cells(i, 12)).Copy
Редко но метко ...
 
 
 
#4
20.01.2011 15:31:28
Эх...
 
 
 
#5
20.01.2011 15:35:43
Спасибо большое ребята! Все работает!
 
 
 
#6
20.01.2011 15:41:10
{quote}{login=Юрий М}{date=20.01.2011 03:31}{thema=}{post}Эх...{/post}{/quote}  
 
вот блин не углядел размер файла, исправлюсь
Редко но метко ...
 
 
 
#7
20.01.2011 17:17:46
Эх... как обычно задача усложнилась...  
В исходном листе с которого копируются данные присутствуют примечания,формулы, форматы значений и условные форматы ячеек. Ребят как подправить , что бы копировались только значения (без формул), примечания и форматы значений (руб, eur и тп), а условные форматы и формулы не присутствовали на том листе куда скопировались данные...
 
 
 
#8
20.01.2011 17:23:09
Разбейте Вашу строку  
<что-то там>.copy Destination:=<куда-то>  
на две:  
<что-то там>.copy  
<куда-то>.pastespecial xlPasteValues
 
 
 
#9
20.01.2011 17:26:04
А, форматы и примечания еще нужны:  
 
<что-то там>.copy  
<куда-то>.pastespecial xlPasteValuesAndNumberFormats  
<куда-то>.pastespecial xlPasteComments
 
 
 
#10
20.01.2011 17:36:34
{quote}{login=Казанский}{date=20.01.2011 05:26}{thema=}{post}А, форматы и примечания еще нужны:  
 
<что-то там>.copy  
<куда-то>.pastespecial xlPasteValuesAndNumberFormats  
<куда-то>.pastespecial xlPasteComments{/post}{/quote}  
 
чет не могу никак код собрать... :-(
 
 
 
#11
20.01.2011 17:43:36
Лариса: "чет не могу никак код собрать... :-(".  
А мо быть не распальцовку делать, а, учтя урок первого поста - удаление большеразмерного примера, приложить удобоваримый - 100кб со смакросом, и тогда м.б... ;-)
 
 
 
#12
20.01.2011 17:45:17
блин... простите не заметила... ща
 
 
 
#13
20.01.2011 17:58:54
вот
 
 
 
#14
20.01.2011 18:33:31
Sub Order()  
Dim i As Long  
With Application  
   .ScreenUpdating = False  
   With Sheets("Order")  
       For i = 6 To 200 'с 6 по 200 строки в столбце А  
           If Not IsEmpty(.Cells(i, 9)) Then  
               Intersect(.Rows(i), .Range("B:K")).Copy  
               With Sheets("Order-Final").Cells(Sheets("Order-Final").Cells(Rows.Count, 9).End(xlUp).Row + 1, 2)  
                   .PasteSpecial xlPasteValuesAndNumberFormats  
                   .PasteSpecial xlPasteFormats  
                   .PasteSpecial xlPasteComments  
               End With  
           End If  
       Next i  
   End With  
   .CutCopyMode = False  
   .ScreenUpdating = True  
End With  
End Sub
 
 
 
#15
21.01.2011 11:03:48
{quote}{login=Казанский}{date=20.01.2011 06:33}{thema=}{post}Sub Order()  
Dim i As Long  
With Application  
   .ScreenUpdating = False  
   With Sheets("Order")  
       For i = 6 To 200 'с 6 по 200 строки в столбце А  
           If Not IsEmpty(.Cells(i, 9)) Then  
               Intersect(.Rows(i), .Range("B:K")).Copy  
               With Sheets("Order-Final").Cells(Sheets("Order-Final").Cells(Rows.Count, 9).End(xlUp).Row + 1, 2)  
                   .PasteSpecial xlPasteValuesAndNumberFormats  
                   .PasteSpecial xlPasteFormats  
                   .PasteSpecial xlPasteComments  
               End With  
           End If  
       Next i  
   End With  
   .CutCopyMode = False  
   .ScreenUpdating = True  
End With  
End Sub{/post}{/quote}  
 
Спасибо! Но условные форматы то же переносит. Можно как то это исключить?
 
 
 
#16
21.01.2011 11:26:53
Спасибо еще раз! С УФ разобралась!
 
 
 
Страницы: 1
Наверх