macro- copiar e colar com condição

[fabiosousasa]

Boas pessoal,

eu sou novo nestas andanças e precisava da vossa ajuda.  

Precisava de uma macro que me fizesse o copiar e o colar de uma zona defenida, copiar os valores do modulo 1 até ao modulo 2 e assim sucessivamente até ao modulo 6. 

eu ja consegui fazer uma macro que me consegue copiar e colar, so que ja defeni essa zona, se houver colocação de mais uma linha altera me tudo.

 

 

            A  

1   modulo 1

2     1564

3      235

4     3468

5   modulo 2

6   567

7    809

cumprimentos

Fabio Sá

[fabiosousasa]

esta é a macro que criei. se reparem em defenido a range que copio. o problema é que os operadores podem acrecentar linhas ou apagar e desconfigura a macro toda.

Sub Macro1()
'
' Macro1 Macro
'
'
Range("B4:M2000").ClearFormats

Range("B4:M2000").ClearContents

    Sheets("Autoclave 1").Select
    Range("A5:L30").Select
    Selection.Copy
    Sheets("Comp.A1").Select
    Range("B3").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Autoclave 1").Select
    Range("A31:L58").Select
    Selection.Copy
   Sheets("Comp.A1").Select
    Range("B35").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Sheets("Autoclave 1").Select
    Range("A59:L81").Select
    Selection.Copy
    Sheets("Comp.A1").Select
    Range("B65").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Sheets("Autoclave 1").Select
    Range("A82:L107").Select
    Selection.Copy
   Sheets("Comp.A1").Select
    Range("B95").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Sheets("Autoclave 1").Select
    Range("A108:L135").Select
    Selection.Copy
   Sheets("Comp.A1").Select
    Range("B125").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Sheets("Autoclave 1").Select
    Range("A136:L159").Select
    Selection.Copy
    Sheets("Comp.A1").Select
    Range("B155").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        Range("B3:Q3").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Add Key:= _
        Range("N3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=18
    Range("B35:Q35").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Add Key:= _
        Range("N35"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=18
    Range("B65:Q65").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Add Key:= _
        Range("N65"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=18
    Range("B95:Q95").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Add Key:= _
        Range("N95"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=18
    Range("B125:Q125").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Add Key:= _
        Range("N125"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=18
    Range("B155:Q155").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Add Key:= _
        Range("N155"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=18
    Range("B155:Q155").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Comp.A1").AutoFilter.Sort.SortFields.Clear
End Sub