copy multiple cells to another sheet

  • Thread starter Thread starter ComputerMech
  • Start date Start date
C

ComputerMech

Ok here is what I need help with.
In sheet 1 I have a Invoice I would like to create a database of my customers
So when I have wrote out the Invoice I would like to hit a command button
that would send it to WS 2 next empty row. What would be the best way to do
this.
 
Here is a sample of one method:

ActiveSheet.Selection.Copy Sheets(2).Range("A" & Range("A65536"). _
End(xlUp).Row + 1)

Will put the selected range from the ActiveSheet into the next available row
 
I have found the answer and have it working now thanks for all your help here
is the code that i ended up using

Sub Copy_Next_Each_Other()
Dim smallrng As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
Dim SourceRange As Range, I As Integer

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

'fill in the Source Sheet and range
Set SourceRange =
Sheets("Sheet2").Range("f5,f6,f7,f8,c10,a13,a16,j32,j33,j41,i45")

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("Sheet6")
Lr = LastRow(DestSheet)
I = 1

For Each smallrng In SourceRange.Areas

'We make DestRange the same size as smallrng and use the
'Value property to give DestRange the same values
With smallrng
Set DestRange = DestSheet.Cells(Lr + 1, I) _
.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = smallrng.Value
I = I + smallrng.Columns.Count

Next smallrng

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub



Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Please note that this is not my code but I have forgot the wed site to which
it came if anyone does know where it came from please post
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top