SHARE
TWEET

Untitled

a guest Aug 17th, 2019 102 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub Загрузка_данных_о_партиях()
  2.  
  3. 'удаляем первый лист с отключением запроса на подтверждение удаления
  4.  
  5.     Application.DisplayAlerts = False
  6.     Sheets("Схема документа").Delete
  7.     Application.DisplayAlerts = True
  8.  
  9. 'Погнали копипастить
  10.  
  11.     Dim iLastRow As Long
  12.  
  13. 'Вся эта хрень повторяется столько раз, сколько листов в книге
  14. 'не считая первого удаленного и Листа2 на который все копируется
  15. 'т.е. 7 раз (если заводов станет больше, просто увеличим количество
  16. 'повторений цикла). --
  17. '                    |
  18. For s = 1 To 7   '<---
  19.  
  20. 'Идем на лист 2 и выбираем нужную ячейку в конце списка
  21.        Sheets("Лист2").Select
  22.         Cells(10, 3).Select
  23.         iLastRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
  24.         Cells(iLastRow + 1, ActiveCell.Column).Select
  25.    
  26. 'Идем на Лист (п/н2) следующий за Листом2 и
  27. 'копируем нужный диапазон
  28.        Sheets(2).Select
  29.         Range("B10:U10").Select
  30.         Range(Selection, Selection.End(xlDown)).Select
  31.         Selection.Copy
  32.        
  33. 'Идем обратно на страницу Лист2 и всавляем полученные с Листа(п/н2) данные.
  34.        Sheets("Лист2").Select
  35.         ActiveSheet.Paste
  36.        
  37. 'Удаляем листы 3-9 из книги. Т.е. после каждого копипаста
  38. 'удаляем следующий за Лист2
  39.        Application.DisplayAlerts = False
  40.         Sheets(2).Delete
  41.         Application.DisplayAlerts = True
  42.        
  43. 'и по новой
  44. Next s
  45.  
  46. 'ну и красоты ради вернемся обратно в начало таблицы
  47.    Sheets("Лист2").Select
  48.     Cells(10, 3).Select
  49.    
  50. 'Сохраняем книгу как...
  51.    Application.Dialogs(xlDialogSaveAs).Show "StandAlone" & "_" & Format(Date, "YYYYMMDD"), xlOpenXMLWorkbook
  52.    
  53.  
  54. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top