Problem with vba copy paste range of cells

[Konrado]

Hi

I have problem with my macro. I want to copy and paste a range of cells from one sheet to another. Excels shows fail in line with Worksheets("Data").Range("B14:B" & Lr).Select everytime.

Sub ApprovalListMatrixDone()

'Kopiowanie zakresów między arkuszami


Dim Lr As Long
Dim Lr1 As Long


With Worksheets("Data")
Lr = Cells(Rows.Count, "B").End(xlUp).Row
Lr1 = Cells(Rows.Count, "J").End(xlUp).Row
End With


Worksheets("Data").Range("B14:B" & Lr).Select
Selection.Copy
Worksheets("Report").Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False


Worksheets("Data").Range("J14:J" & Lr1).Select
Selection.Copy
Worksheets("Report").Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False


End Sub

 

[AlphaFrog]

With Worksheets("Data")
Lr = [COLOR=#ff0000][SIZE=4].[/SIZE][/COLOR]Cells(Rows.Count, "B").End(xlUp).Row
Lr1 = [COLOR=#ff0000][SIZE=4].[/SIZE][/COLOR]Cells(Rows.Count, "J").End(xlUp).Row
End With

Missing a period in front of the Cells statement to use the sheet from the With statement. Otherwise, the Cells statement uses the Active sheet which may not be the Data sheet.

Also, you cannot select a range on a sheet like this...
Worksheets("Data").Range("B14:B" & Lr).Select
...if the sheet is not already selected.

Try this...
Application.GoTo Worksheets("Data").Range("B14:B" & Lr)

 

[dmt32]

Hi,
see if this change to your code helps:

Sub ApprovalListMatrixDone()


'Kopiowanie zakresów miedzy arkuszami


    Dim Lr As Long
    Dim Lr1 As Long
    With Worksheets("Data")
        Lr = .Cells(.Rows.Count, "B").End(xlUp).Row
        Lr1 = .Cells(.Rows.Count, "J").End(xlUp).Row


        .Range("B14:B" & Lr).Copy Worksheets("Report").Range("B1")


        .Range("J14:J" & Lr1).Copy Worksheets("Report").Range("J1")


    End With


End Sub

Dave

 

[AlphaFrog]

Another way.

[color=darkblue]Sub[/color] ApprovalListMatrixDone()
    
    [color=green]'Kopiowanie zakresów mie;dzy arkuszami[/color]
    
    [color=darkblue]With[/color] Worksheets("Data")
        .Range("B14", .Range("B" & Rows.Count).End(xlUp)).Copy _
            Destination:=Worksheets("Report").Range("B1")
        .Range("J14", .Range("J" & Rows.Count).End(xlUp)).Copy _
            Destination:=Worksheets("Report").Range("J1")
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[Konrado]

Hi

Your solutions work, thank you very much! It seems that I have now another problem. In bolded line macro is stopped by excel due to some fail. I don't understand, why. It works only when I start macro in worksheet "Report". Starting it in another sheet, excel shows problem. Your help will be highly appreciated.

Sub ApprovalListMatrixDone()


'Kopiowanie zakresów między arkuszami i usuwanie duplikatów


Application.ScreenUpdating = False


Dim lr1, lr2 As Long
Dim sht As Worksheet


Set sht = Worksheets("Report")


Worksheets("Report").Columns("A:BG").EntireColumn.Delete


With Worksheets("Data")


lr1 = .Cells(.Rows.Count, "B").End(xlUp).Row
lr2 = .Cells(.Rows.Count, "J").End(xlUp).Row


.Range("B14:B" & lr1).Copy Worksheets("Report").Range("A1")


.Range("J14:J" & lr1).Copy Worksheets("Report").Range("B1")


End With


With Worksheets("Report")


.Columns("A:B").AutoFit
.Columns("A:A").Copy Range("E1")
Application.CutCopyMode = False
.Range("$E$1:$E$3000").RemoveDuplicates Columns:=1, Header:= _
xlYes


End With


Sheets("Pattern").Range("A1:BA1").Copy Sheets("Report").Range("F1")


'Trackowanie ścieżki akceptacji

sht.Range("F2").FormulaArray = _
"= UPPER(IFERROR(INDEX(R2C1:R2500C2,SMALL(IF(R2C1:R2500C1=RC5,ROW(R2C1:R2500C1)-1),COLUMNS(RC6:RC)),2),""""))"
sht.Range("F2").Select
Selection.AutoFill Destination:=Range("F2:AD2"), Type:=xlFillDefault
sht.Range("F2:AD2").Select
Selection.AutoFill Destination:=Range("F2:AD2500")
sht.Columns("F:AD").AutoFit


'Generowanie approval limits


sht.Range("AE2").Formula = _
"=IFERROR(VLOOKUP(VLOOKUP(Report!RC[-25],'List with grades'!C1:C4,3,0),'Matrix with limits'!R3C1:R10C3,3,0),"" "")"
sht.Range("AE2").Select
Selection.AutoFill Destination:=Range("AE2:BC2"), Type:=xlFillDefault
sht.Range("AE2:BC2").Select
Selection.AutoFill Destination:=Range("AE2:BC2500")
sht.Range("AE2:BC2500").Select
Selection.NumberFormat = "#,##0.00"
sht.Columns("AE:BC").AutoFit






End Sub

 

[AlphaFrog]

Same reason as the "Also" part of post #2.

 

[Konrado]

In place of every "sht" should I put "Application.GoTo sht"? Could you show some example how can I convert it? I am thankful for your contribution.

 

[AlphaFrog]

You could select it like this.
sht.Select
Range("F2").Select

Or this...
Application.GoTo sht.Range("F2")

Or better yet, don't .Select anything

'Trackowanie ścieżki akceptacji

sht.Range("F2").FormulaArray = _
"= UPPER(IFERROR(INDEX(R2C1:R2500C2,SMALL(IF(R2C1:R2500C1=RC5,ROW(R2C1:R2500C1)-1),COLUMNS(RC6:RC)),2),""""))"
sht.Range("F2").AutoFill Destination:=sht.Range("F2:AD2"), Type:=xlFillDefault
sht.Range("F2:AD2").AutoFill Destination:=sht.Range("F2:AD2500")
sht.Columns("F:AD").AutoFit

Or best yet, don't use Autofill as well

'Trackowanie ścieżki akceptacji

sht.Range("F2:AD2500").FormulaArray = _
"= UPPER(IFERROR(INDEX(R2C1:R2500C2,SMALL(IF(R2C1:R2500C1=RC5,ROW(R2C1:R2500C1)-1),COLUMNS(RC6:RC)),2),""""))"
sht.Columns("F:AD").AutoFit

 

[Konrado]

AlphaFrog

This code doesn't work because we put the same formula in each cell and we have the same result.

'Trackowanie ścieżki akceptacjisht.Range("F2:AD2500").FormulaArray = _"= UPPER(IFERROR(INDEX(R2C1:R2500C2,SMALL(IF(R2C1:R2500C1=RC5,ROW(R2C1:R2500C1)-1),COLUMNS(RC6:RC)),2),""""))"sht.Columns("F:AD").AutoFit</pre>

 

[Andrew Poulsom]

Put the formula in the first cell and copy/paste it to the remaining cells.