Copying parts of a sheet with macro

  • Thread starter Thread starter Roger Dodger
  • Start date Start date
R

Roger Dodger

Hi All,

recently I have learned how to record and use macros (with a fair bit of
help from this group) and I have got them working well, except for one.

At present I click on the macro and it goes to sheet 2 and selects and
copies A2 down to end of data, then pastes it in sheet 1 from A6 down.
Next it goes back to Sheet 2 and selects C2 accross to end of data and then
down to end of data and copies it and pastes it into sheet 1 from C6 down to
bottom.
There are about 1800 rows and it takes a while to do. I must be impatient.
On Sheet 1 column B is vlookup for other relevant data. I am not sure that
this makes a difference.

This macro works however is there a better way to do this easier or maybe
faster?

Thanks
Kevin
 
Post the code that you are using. If this has been produced by
recording keystrokes, then there are probably many selections made,
and these can often be improved on.

Pete
 
Here it is Pete


Sheets("Raw data").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet1").Select
Range("A6").Select
ActiveSheet.Paste
Sheets("Raw data").Select
Range("C2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A2").Select
Sheets("Sheet1").Select
Range("C6").Select
ActiveSheet.Paste
Range("A6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("B8").Select
Range("A5:N1799").Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=
_
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.AutoFilter Field:=3, Criteria1:=">4-Aug-2010", Operator:=xlAnd
End Sub


Post the code that you are using. If this has been produced by
recording keystrokes, then there are probably many selections made,
and these can often be improved on.

Pete
 
Here it is Pete

    Sheets("Raw data").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A6").Select
    ActiveSheet.Paste
    Sheets("Raw data").Select
    Range("C2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A2").Select
    Sheets("Sheet1").Select
    Range("C6").Select
    ActiveSheet.Paste
    Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("B8").Select
    Range("A5:N1799").Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=
_
        xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Selection.AutoFilter Field:=3, Criteria1:=">4-Aug-2010", Operator:=xlAnd
End Sub


Post the code that you are using. If this has been produced by
recording keystrokes, then there are probably many selections made,
and these can often be improved on.

Pete







- Show quoted text -
Click to expand...

try this
with Sheets("Raw data")
.Range("a2", Range("a2").End(xlDown)).copy
Sheets("Sheet1").Range("A6")
.Range("c2", Range("a2").End(xlDown).End(xlToRight)).copy
Sheets("Sheet1").Range("C6")
.Range("a6",
Range("a6").End(xlDown).End(xlToRight)).borders.linestyle=xlContinuous
.Range("A5:N1799").Sort Key1:=Range("B5"), Order1:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
Selection.AutoFilter Field:=3, Criteria1:=">4-Aug-2010",
Operator:=xlAnd
end with
End Sub
 
try this
with Sheets("Raw data")
   .Range("a2", Range("a2").End(xlDown)).copy
Sheets("Sheet1").Range("A6")
   .Range("c2", Range("a2").End(xlDown).End(xlToRight)).copy
Sheets("Sheet1").Range("C6")
   .Range("a6",
Range("a6").End(xlDown).End(xlToRight)).borders.linestyle=xlContinuous
   .Range("A5:N1799").Sort Key1:=Range("B5"), Order1:=xlAscending,
Header:=  _
      xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
    Selection.AutoFilter Field:=3, Criteria1:=">4-Aug-2010",
Operator:=xlAnd
end with
End Sub- Hide quoted text -

- Show quoted text -
Click to expand...

Be sure to correct for word wrap
 
with Sheets("Raw data")
.Range("a2", Range("a2").End(xlDown)).copy
Sheets("Sheet1").Range("A6")
.Range("c2", Range("a2").End(xlDown).End(xlToRight)).copy
Sheets("Sheet1").Range("C6")
.Range("a6",
Click to expand...

I get a compile error Here
 
There are some Range objects that need a leading dot:

with Sheets("Raw data")
.Range("a2", .Range("a2").End(xlDown)).copy
Sheets("Sheet1").Range("A6")

.Range("c2", .Range("a2").End(xlDown).End(xlToRight)).copy
Sheets("Sheet1").Range("C6")

.Range("a6", _
.Range("a6").End(xlDown).End(xlToRight)).borders.linestyle=xlContinuous

.Range("A5:N1799").Sort Key1:=.Range("B5"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _

'This is working on the selection -- which may not be what you
'want!
Selection.AutoFilter Field:=3, Criteria1:=">4-Aug-2010",

end with
End Sub
 
There are some Range objects that need a leading dot:

with Sheets("Raw data")
    .Range("a2", .Range("a2").End(xlDown)).copy
        Sheets("Sheet1").Range("A6")

    .Range("c2", .Range("a2").End(xlDown).End(xlToRight)).copy
        Sheets("Sheet1").Range("C6")

    .Range("a6", _
       .Range("a6").End(xlDown).End(xlToRight)).borders.linestyle=xlContinuous

    .Range("A5:N1799").Sort Key1:=.Range("B5"), Order1:=xlAscending, _
       Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
       Orientation:=xlTopToBottom, _

     'This is working on the selection -- which may not be what you
     'want!
     Selection.AutoFilter Field:=3, Criteria1:=">4-Aug-2010",

end with
End Sub
Click to expand...

Also missing line continuation. Surely your vba editor is showing in
red...
If you still have problems send me your file to (e-mail address removed)
and this msg.
 
Back
Top