ExcelBanter - Copying from one worksheet to another worksheet

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Copying from one worksheet to another worksheet (https://www.excelbanter.com/excel-programming/390025-copying-one-worksheet-another-worksheet.html)

Gene

Copying from one worksheet to another worksheet

Can't find my original post. Thank you to all who provided input to the
original post. Here is what I currently use (called from a toolbar):
Sub SelectItem()
'
' SelectItem Macro
' Macro recorded 05/21/2007 by EuGene C. White, CNA
'
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Sheets("Orders").Select
Range("ID").Select
Selection.Copy
Range("A31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
' Insert code for date here?
Range("B31").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("O_STSC").Select
Application.CutCopyMode = False
Selection.Copy
Range("C31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("O_TEBC2").Select
Application.CutCopyMode = False
Selection.Copy
Range("D31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("O_TPPC").Select
Application.CutCopyMode = False
Selection.Copy
Range("E31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("F31").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(RC[-3],RC[-2],RC[-1])"
Range("O_FSP").Select
Selection.Copy
Range("G31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A31:G31").Select
Selection.Copy
Sheets("Profit_Loss_Statement").Select
Range("A2").Select
Do Until Cells(ActiveCell.Row + 1, 1) = ""

If ActiveCell = "" Then
ActiveCell.Offset(1, 1).Select
Else
Cells(ActiveCell.Row + 1, 1).Select
End If
Loop
Cells(ActiveCell.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("Orders").Select
Range("A31:G31").Select
Selection.ClearContents
Range("ID").Select
Application.CutCopyMode = False
End Sub

Might not be the best solution, but it works. I have not done any Excel VBA
before, just Word and VBScript.
/s/ Gene

Don Guillett

Copying from one worksheet to another worksheet

Gene

Copying from one worksheet to another worksheet

Don,
Thank you very much. Learning Excel VBA should be rather easy with folks
like you to assist me.
/s/ Gene

"Don Guillett" wrote:

You should try to do withOUT selections as they are rarely necessary and
slow down code. You probably won't need the application off/on.
Use the with statement as you did with those. Don't forget to put the .
s in the right places.

SelectItem Macro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

with Sheets("Orders")
.range("A31").value=.Range("ID")
.Range("A31")=NOW()
.Range("C1").value=.Range("OF_SETS")
'etc
Range("OF_TEBC2").Select
Application.CutCopyMode = False
Selection.Copy
Range("D31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("O_TPPC").Select
Application.CutCopyMode = False
Selection.Copy
Range("E31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("F31").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(RC[-3],RC[-2],RC[-1])"
Range("O_FSP").Select
Selection.Copy
Range("G31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'------
.Range("A31:G31").Copy Sheets("Profit_Loss_Statement").Range("A2")

'????
Do Until Cells(ActiveCell.Row + 1, 1) = ""
If ActiveCell = "" Then
ActiveCell.Offset(1, 1).Select
Else
Cells(ActiveCell.Row + 1, 1).Select
End If
Loop
Cells(ActiveCell.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("Orders").Range("A31:G31").ClearContents

' Range("ID").Select
Application.CutCopyMode = False

With Application
.ScreenUpdating =true
.EnableEvents =true
End With

End Sub

--
Don Guillett
SalesAid Software

"Gene" wrote in message
...
Can't find my original post. Thank you to all who provided input to the
original post. Here is what I currently use (called from a toolbar):
Sub SelectItem()
'
' SelectItem Macro
' Macro recorded 05/21/2007 by EuGene C. White, CNA
'
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Sheets("Orders").Select
Range("ID").Select
Selection.Copy
Range("A31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
' Insert code for date here?
Range("B31").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("O_STSC").Select
Application.CutCopyMode = False
Selection.Copy
Range("C31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("O_TEBC2").Select
Application.CutCopyMode = False
Selection.Copy
Range("D31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("O_TPPC").Select
Application.CutCopyMode = False
Selection.Copy
Range("E31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Range("F31").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(RC[-3],RC[-2],RC[-1])"
Range("O_FSP").Select
Selection.Copy
Range("G31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A31:G31").Select
Selection.Copy
Sheets("Profit_Loss_Statement").Select
Range("A2").Select
Do Until Cells(ActiveCell.Row + 1, 1) = ""

If ActiveCell = "" Then
ActiveCell.Offset(1, 1).Select
Else
Cells(ActiveCell.Row + 1, 1).Select
End If
Loop
Cells(ActiveCell.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("Orders").Select
Range("A31:G31").Select
Selection.ClearContents
Range("ID").Select
Application.CutCopyMode = False
End Sub

Might not be the best solution, but it works. I have not done any Excel
VBA
before, just Word and VBScript.
/s/ Gene

All times are GMT +1. The time now is 02:51 AM.