VBA - Transferring select Data to new sheet

Thanks Trowa - this was good but it was a bit clunky as it was referencing actual cells instead of the headings, so it didn't allow for easy changes to be made to the document.

I was desperate for an answer and asked on another forum as well and got this code in answer:

'takes selected rows of data and transfers to the Archive spreadsheet
Sub ArchiveToCurrent()

Dim fnd As Range, rngSel As Range
Dim shCurrent As Worksheet, shDestin As Worksheet
Dim shSource As Variant, arrSource As Variant
Dim nxRow As Long, r1 As Long, r2 As Long
Dim stCol As Long, enCol As Long, c As Long

Application.ScreenUpdating = False

Set shCurrent = ActiveSheet
Set shDestin = Sheets("Archive")

arrSource = Array("Current") 'change as needed
For Each shSource In arrSource
Sheets(shSource).Activate
For Each rngSel In Selection.Areas
stCol = rngSel.Cells(1, 1).Column
enCol = stCol + rngSel.Columns.Count - 1
nxRow = shDestin.Cells(1, 1).CurrentRegion.Rows.Count + 1
For c = stCol To enCol
If Cells(1, c) = "" Then Exit For
Set fnd = shDestin.Rows(1).Find(Cells(1, c), , , xlWhole)
If Not fnd Is Nothing Then
r2 = nxRow
For r1 = 1 To rngSel.Rows.Count
shDestin.Cells(r2, fnd.Column) = rngSel.Cells(r1, c - stCol + 1).Value
r2 = r2 + 1
Next r1
End If
Set fnd = Nothing
Next c
Next rngSel
For Each rngSel In Selection.Areas
rngSel.ClearContents
Next rngSel
Next shSource
shCurrent.Activate

ActiveSheet.Select
Selection.EntireRow.Delete
End Sub

Which works beautifully - I hope you find it helpful too :)

I've got one other question though and the other forum is down at the moment so I couldn't go back to the original person who wrote this - so wondered if you might know the answer?

I want to use this code to copy the selected rows to another spreadsheet (which it does already) but this time I want it to include on the destination worksheet the name of the worksheet the information was taken from - in a column which is headed 'Sheet Name'.

Do you have any suggestions?

Actually ignore my above question. I found a work around. I would however like to use the code you gave me to do something slightly different...

I tried adapting it but couldn't quite work out the right way to do it.

I'd like to use your code to shift a selected row to another spreadsheet taking specific cells from the selection and placing them in very specific locations e.g. copy the cell located in column A of the selected range and paste to C4 on the new sheet, copy the cell located in column Bof the selected range and paste to D4 on the new sheet, copy the cell located in column E of the selected range and paste to C13 on the new sheet etc.

Are you able to suggest some tweaks to your code for doing this?

Your help is sincerely appreciated :)

Hi VirtualInsanity,

Thanks for sharing the code and good to see you are getting closer to getting the desired result.

Now for your recent question let's look at a part of my posted code:

If ActiveSheet.Name = ws1 Then
Union(Cells(x, "A"), Cells(x, "B"), Cells(x, "C"), Cells(x, "D"), Cells(x, "E"), Cells(x, "H"), Cells(x, "J")).Copy _
Destination:=Sheets(ws3).Range("A" & lRow)
Union(Cells(x, "A"), Cells(x, "B"), Cells(x, "C"), Cells(x, "D"), Cells(x, "E"), Cells(x, "H"), Cells(x, "J")).ClearContents
End If

Change this into:

If ActiveSheet.Name = ws1 Then
Cells(x,"A").cut Destination:=Sheets(ws3).Range("C4")
Cells(x,"B").cut Destination:=Sheets(ws3).Range("D4")
Cells(x,"E").cut Destination:=Sheets(ws3).Range("C13")
End if

This way you can simply add additional cut/paste actions.
Do NOTE that the destination cells will be overwritten when running the code subsequent times.

Best regards,
Trowa

Brilliant - thanks so much :)

One last quick question. Is there a way to get it to presevere the formatting of the destination cell. So only copying across the text - not the formats?

Hi TrowaD,

Yes that's essentially it. We actually have 2 original spreadsheets that hold data - some of the headers are the same , some different. The idea is we want to create a button that runs a macro and takes the highlighted row (or rows) of data from whatever original spreadsheet we're on and copies it to an archive sheet. The archive sheet will only have the headings of the data that we want to keep (matching some the headings on the 2 original spreadsheets) but there would be some headings on the Archive Sheet that are specific to original spreadsheet 1 but not original spreadsheet 2 and vice versa. Hope that makes sense?

Just some additional info that might help.

On original spreadsheet 1 the columns with the data we want to keep are A,B,C,D,E, H, J.
On original Spread Sheet 2 the columns with the data we want to keep are A,B,C,D,E, G, L and S.

When we select a row from which ever of the original sheets we're on and run the macro, we wish to cut/paste the data from those columns of that row to the Archive sheet.

Hope that's helpful. Looking forward to hearing your thoughts on this...