Страницы: 1
RSS
Модернизация макроса копирования данных
 
Ребята, в общем есть макрос, есть книга с множеством листов, лист с именем "Svod" - собирает на себя информацию с остальных листов начиная с строки №100, можно ли сделать так, чтоб он начинал собирать эти диапазоны со строки №6, но при этом на листе "Svod" все так же выстраивал из строки №100?
Код
Sub BuildPlan()

Range("A100:S5000").Select
   Selection.ClearContents
   
    Const startCell = "A100"
    
    Dim ws As Worksheet, sv As Worksheet
    Dim cell As Range, tbl As Range, shift&
    
    Set sv = ThisWorkbook.Worksheets("Svod")
    Set cell = sv.Range(startCell)
    cell.CurrentRegion.Offset(cell.Row - cell.CurrentRegion.Row).Clear
    
    For Each ws In ThisWorkbook.Worksheets
        If Not ws Is sv Then
            Set tbl = ws.Range(startCell).CurrentRegion
            shift = ws.Range(startCell).Row - tbl.Row
            If tbl.Rows.Count - shift > 0 Then
                tbl.Offset(shift).Resize(tbl.Rows.Count - shift).Copy cell
                Set cell = cell.Offset(tbl.Rows.Count - shift)
            End If
        End If
    Next
End Sub
 
1. Где Ваш файл?
Цитата
KoguarLTE написал:
можно ли сделать так, чтоб он начинал собирать эти диапазоны со строки №6, но при этом на листе "Svod" все так же выстраивал из строки №100?
2. Покажите в Вашем файле, как это должно "выглядеть"?  ;)  
 
Код
[/CODE][CODE]
Sub BuildPlan()
 
Range("A100:S5000").Select
   Selection.ClearContents
    
    Const startCell = "A6"
    Const stCell = "A100"
     
    Dim ws As Worksheet, sv As Worksheet
    Dim cell As Range, tbl As Range, shift&
     
    Set sv = ThisWorkbook.Worksheets("Svod")
    Set cell = sv.Range(stCell) ' changed
    cell.CurrentRegion.Offset(cell.Row - cell.CurrentRegion.Row).Clear
     
    For Each ws In ThisWorkbook.Worksheets
        If Not ws Is sv Then
            Set tbl = ws.Range(startCell).CurrentRegion
            shift = ws.Range(startCell).Row - tbl.Row
            If tbl.Rows.Count - shift > 0 Then
                tbl.Offset(shift).Resize(tbl.Rows.Count - shift).Copy cell
                Set cell = cell.Offset(tbl.Rows.Count - shift)
            End If
        End If
    Next
End Sub
Изменено: nbaengineer - 21.03.2019 11:42:28
Вредить легко, помогать трудно.
 
nbaengineer, спасибо дядь! То что нужно!
Мотя, извините, файл конфиденциальный) Спасибо за отклик!  
 
Ребята, помогите пожалуйста! Вот значит макрос копирующий на лист "Svod" со строки 77 много-много ячеек из остальных листов начиная со строки 5 в этой книге. Работает как надо. Почти как надо. Я заметил, что те формулы которые находятся на определенных листах и ссылаются на другие листы, при копировании на "Svod" копируются не правильно.
Пример: на листе "1.1" в ячейке С5 формула "=C6+'1.2'!C5+'1.3'!C5+'1.4'!C5+'1.5'!C5+'1.6'!C5+'1.7'!C5+'1.8'!C5", но при копировании ее на Svod получаем →
"=C74+'1.2'!C73+'1.3'!C73+'1.4'!C73+'1.5'!C73+'1.6'!C73+'1.7'!C73+'1.8'!C73"

Помогите как-то решить проблему, пожалуйста.
В принципе было бы хорошо, если копировались данные как значения, а не функции.
Заранее извиняюсь, что не приложу файл, он секретный, извините ):
Код
Sub BuildPlan()

Range("A77:U3000").Select
Selection.Delete


Const startCell = "A5"
Const stCell = "A73"

Dim ws As Worksheet, sv As Worksheet
Dim cell As Range, tbl As Range, shift&

Set sv = ThisWorkbook.Worksheets("Svod")
Set cell = sv.Range(stCell)
cell.CurrentRegion.Offset(cell.Row - cell.CurrentRegion.Row).Clear

For Each ws In ThisWorkbook.Worksheets
If Not ws Is sv Then
Set tbl = ws.Range(startCell).CurrentRegion
shift = ws.Range(startCell).Row - tbl.Row
If tbl.Rows.Count - shift > 0 Then
tbl.Offset(shift).Resize(tbl.Rows.Count - shift).Copy cell
Set cell = cell.Offset(tbl.Rows.Count - shift)
End If
End If
Next
End Sub
Изменено: KoguarLTE - 29.03.2019 12:27:50
 
nbaengineer, дядь, помоги пожалуйста)
Страницы: 1
Наверх