Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Скопировать диапазон средствами VBA
 
#1
26.05.2011 23:16:57
Добрый вечер!:)  
   
 Задача этого макроса открыть файл типа .csv, преобразовать его в xlsm, потом скопировать диапазона:  
     "A1:D" - где в D последная занятая ячеяка увеличивает свой номер, т.е. столбец D - типа "динамический", если можно так выразиться.  
      Прочитав не мало страниц форума понравилось для этой цели:  
         
      Range("A1:D" & Cells(Rows.Count, 4).End(xlDown)).Copy  
         
      но, на этой строчке макрос затыкается и выдает ошибку:  
 
      Run-time error '1004':  
      Method 'Range' of object '.Global' failed.  
 
      Подскажите, как мне выти из этого положения?  
      Вот и сам макрос:  
         
Sub CSVXLSCOPY()  
     
     Workbooks.OpenText Filename:= _  
       "путь к файлу.csv", _  
       Origin:=866, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _  
       xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _  
       Comma:=False, Space:=False, Other:=True, FieldInfo:=Array(Array(1, 1), _  
       Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True  
   Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _  
       TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _  
       Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _  
       :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _  
       True  
   Columns("C:C").ColumnWidth = 15.38  
   Columns("D:D").NumberFormat = "0.0000"  
       Columns("D:D").Select  
       ActiveCell.FormulaR1C1 = "=ROUNDDOWN(C,4)"  
   ActiveWorkbook.SaveAs Filename:= _  
       "путь к файлу.xlsm", _  
       FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False  
     ActiveCell.End(xlDown).Select  
     Range("A1:D" & Cells(Rows.Count, 4).End(xlDown)).Copy  
   ActiveWindow.ScrollWorkbookTabs Position:=xlFirst  
   Sheets("Имя листа").Select  
   Range("P1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _  
       , SkipBlanks:=False, Transpose:=False  
   Range("P1").Select  
 
End Sub
 
 
 
#2
26.05.2011 23:22:16
а так?  
Range("A1:D" & Cells(Rows.Count, 4).End(xlDown).row).Copy  
 
PS а что означают буквы fx в Вашем нике, если не секрет?
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#3
26.05.2011 23:35:00
{quote}{login=ikki}{date=26.05.2011 11:22}{thema=}{post}а так?  
Range("A1:D" & Cells(Rows.Count, 4).End(xlDown).row).Copy  
 
PS а что означают буквы fx в Вашем нике, если не секрет?{/post}{/quote}  
 
Выдало сообщение:  
Run-time error '9':  
Subscript out of range  
 
"а что означают буквы fx в Вашем нике" - на одном форуме попыталькя зарегиться под ником "pro11", но это имя было занято и предложи выбрать из списка.
 
 
 
#4
26.05.2011 23:38:53
не... что-то я перетрудился сегодня :(  
 
вот так: Range("A1:D" & Cells(Rows.Count, 4).End(xlUp).Row).Copy  
 
...наверное :))
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#5
26.05.2011 23:39:37
Range("A1:D" & Cells(1, 4).End(xlDown).row).Copy
 
 
 
#6
27.05.2011 00:07:15
Сработало без задоринки!:)  
 
Вот окончательный вид макроса:  
Sub CSVXLSCOPY()  
     
     Workbooks.OpenText Filename:= _  
       "путь к файлу.csv", _  
       Origin:=866, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _  
       xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _  
       Comma:=False, Space:=False, Other:=True, FieldInfo:=Array(Array(1, 1), _  
       Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True  
   Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _  
       TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _  
       Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _  
       :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _  
       True  
   Columns("C:C").ColumnWidth = 15.38  
   Columns("D:D").NumberFormat = "0.0000"  
       Columns("D:D").Select  
       ActiveCell.FormulaR1C1 = "=ROUNDDOWN(C,4)"  
     
   ActiveWorkbook.SaveAs Filename:= _  
       "путь к файлу.xlsm", _  
       FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False  
     ActiveCell.End(xlDown).Select  
     Range("A1:D" & Cells(Rows.Count, 4).End(xlUp).Row).Copy  
      Windows("адресс книги.xlsm").Activate  
   ActiveWindow.WindowState = xlMaximized  
   ActiveSheet.Paste  
   Range("P1").Select  
End Sub  
 
 Темму можно считать закрытой.  
 Спасибо ikki, не смотря но усталость отловили мою ошибку!  
 
 Kuzmich, сейчас попробую и этот вариант.
 
 
 
#7
27.05.2011 00:12:49
{quote}{login=Kuzmich}{date=26.05.2011 11:39}{thema=Re}{post}Range("A1:D" & Cells(1, 4).End(xlDown).row).Copy{/post}{/quote}  
 
Так, тоже сработало, спасибо за участие!  
 
Доброй ночи всем!
 
 
 
Страницы: 1
Читают тему
Наверх