how to copy cells from sheet 1 to sheet 2 without removing data on sheet 2 - vba

I need code, as my title suggests, for the following task. I already tried a lot of different code but it's still not working.
I only need to move 2 columns, "SKU" and "Discount", into sheet2 using command button and delete it right away.
I'm already okay for this coding. However, but the problem is just beginning.
When I succeed to moved the first data, and try to move the 2nd data, the 1st data disappears.
I already tried many ways but still can't figure it out what's wrong with the code.
Please check the following code:
Sub OUTGOING_GOODS()
function1
function2
clear
Range_End_Method
End Sub
Sub function1()
Sheets("Invoice Print").Range("B21:B27").Copy Destination:=Sheets("Outgoing Goods").Range("D4")
End Sub
Sub function2()
Sheets("Invoice Print").Range("D21:D27").Copy Destination:=Sheets("Outgoing Goods").Range("L4")
End Sub
Sub clear()
Range("B21:B27").clear
End Sub
I also need to change the range for input data as well. As you can see the Range is defined only from D21:D27, but I need more than row 27 just in case there is additional data inputted.
Already tried the following code:
With Worksheets("Sheet2")
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
For Each cell In Range("D4:D" & LastRow)
DestinationRow = LastRow + 1
Next
For Each cell In Range("L4:L" & LastRow)
DestinationRow = LastRow + 1
Next
End With
And
Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To InputData
Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 1 To 3
.Cells(lastrow + 1, j).Value = InputData(i, j)
Next j
Next i
End With
This still isn't working.

Based on our discussions thus far I'd suggest the following:
Sub Outgoing_Goods_New()
'
Dim Outgoing As Worksheet 'Generally it's better to use Worksheet variables. Saves the trouble of having to re-type the sheet name each time you reference the sheet
Dim Invoice As Worksheet
Dim LastRow_Invoice As Long
Dim LastRow_Outgoing As Long
Set Outgoing = ActiveWorkbook.Worksheets("Outgoing Goods")
Set Invoice = ActiveWorkbook.Worksheets("Invoice Print")
'Find the last row of Outgoing column D that's used so we know where to paste the new set of outgoing goods
LastRow_Outgoing = Outgoing.Range("D1048576").End(xlUp).Row
'Make sure column L of Outgoing ends at the same point
If Outgoing.Range("L1048576").End(xlUp).Row > LastRow_Outgoing Then
LastRow_Outgoing = Outgoing.Range("L1048576").End(xlUp).Row
End If 'else column L's last used row is farther up the worksheet or the same row. Either way no need to update the value
'Determine how much data to copy
LastRow_Invoice = Invoice.Range("B1048576").End(xlUp).Row 'I'm assuming Column D of Invoice Print has to end at the same row. If not, use the same IF statement as above, but
'checking column D of Invoice
'Copy the data from column B
Invoice.Range("B2:B" & LastRow_Invoice).Copy
'Paste to Outgoing Goods
Outgoing.Range("B" & LastRow_Outgoing).PasteSpecial xlPasteAll
'Copy Column D of Invoice
Invoice.Range("D2:D" & LastRow_Invoice).Copy
Outgoing.Range("L" & LastRow_Outgoing).PasteSpecial xlPasteAll
'Clear the data from Invoice print
Invoice.Range("B2:B" & LastRow_Invoice).ClearContents 'Removes the Value, but leaves formatting, comments, etc. alone
End Sub
This is mostly the logic you already had, but I did some clean-up to remove ambiguities and genericize the logic a little. Also, notice that I didn't keep the separate Subs. With how little you're doing there's just not any benefit to parsing the logic, especially with none of the code being re-used.
Last, I didn't delete column D on Invoice Print assuming that the cells just held formulas that pull in new data based on the values in Column B. If that's not the case, it seems like you should add a second ClearContents to delete Column D as well, but that's not certain given the vagueness of your use case.

Related

Macro VBA to Copy Column based on Header and Paste into another Sheet

Background: This is my first time dealing with macros. I will have two worksheets that I’ll be using. The first sheet, ‘Source’ will have data available. The second sheet, ‘Final’ will be blank and is going to be where the macro will be pasting the data I’d like it to collect from the ‘Source’ sheet.
* I want the macro to find the specified header in the ‘Source’ sheet, copy that cell containing the header all the way down to the last row of existing data (instead of the entire column), and paste it onto the ‘Final’ sheet in a specified column (A, B, C, etc.). *
The reason why I have to specify which headers to find is because the headers in the ‘Source’ sheet won’t always be in the same position, but the ‘Final’ sheet’s headers will always be in the same position – so I CAN’T just record macros copying column A in ‘Source’ sheet and pasting in column A in ‘Final’ sheet. Also, one day the ‘Source’ sheet may have 170 rows of data, and another day it may have 180 rows.
Although, it would probably be best to copy the entire column since one of the columns will have a few empty cells rather than to the last row of existing data. I’m assuming it would stop copying when it reaches the first empty cell in the column chosen which would leave out the remaining data after that empty cell in the column – correct me if I’m wrong. If copying the entire column is the best way, then, please provide that as part of the possible solution. I’ve attached an example of the before & after result I would like accomplished:
Example of Result
Find Header=X, copy entire column -> Paste into A1 in ‘Final’ sheet
Find Header=Y, copy entire column -> Paste into B1 in ‘Final’ sheet
Etc..
I’m sorry if my wording isn’t accurate – I tried to explain the best I could. It’d be awesome if someone could help me out on this! Thanks!
u can try with this. i think its clear and step-by-step. it can be very optimized, but to start with vba i think its better this way.
the name of the column must be the same in both sheets.
Sub teste()
Dim val
searchText = "TEXT TO SEARCH"
Sheets("sheet1").Select ' origin sheet
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
x = Selection.Columns.Count ' get number of columns
For i = 1 To x 'iterate trough origin columns
val = Cells(1, i).Value
If val = searchText Then
Cells(1, i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("sheet2").Select ' destination sheet
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
y = Selection.Columns.Count ' get number of columns
For j = 1 To y 'iterate trough destination columns
If Cells(1, j).Value = searchText Then
Cells(1, j).Select
ActiveSheet.Paste
Exit Sub
End If
Next j
End If
Next i
End Sub
good luck
I modified an answer I gave to another user with similar problem for your case,
I use dictionary function in most of my data sheets so that I can shift columns around without breaking the code, the below code you can shift your columns around and it will still work
the only main restriction is
1. your header names must be unique
2. your header name of interest must be exactly the same.
i.e. your source header of interest is PETER then your Data table should have a header with PETER and it must be unique.
Sub RetrieveData()
Dim wb As Workbook
Dim ws_A As Worksheet
Dim ws_B As Worksheet
Dim HeaderRow_A As Long
Dim HeaderLastColumn_A As Long
Dim TableColStart_A As Long
Dim NameList_A As Object
Dim SourceDataStart As Long
Dim SourceLastRow As Long
Dim Source As Variant
Dim i As Long
Dim ws_B_lastCol As Long
Dim NextEntryline As Long
Dim SourceCol_A As Long
Set wb = ActiveWorkbook
Set ws_A = wb.Worksheets("Sheet A")
Set ws_B = wb.Worksheets("Sheet B")
Set NameList_A = CreateObject("Scripting.Dictionary")
With ws_A
SourceDataStart = 2
HeaderRow_A = 1 'set the header row in sheet A
TableColStart_A = 1 'Set start col in sheet A
HeaderLastColumn_A = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column 'Get number of NAMEs you have
For i = TableColStart_A To HeaderLastColumn_A
If Not NameList_A.Exists(UCase(.Cells(HeaderRow_A, i).Value)) Then 'check if the name exists in the dictionary
NameList_A.Add UCase(.Cells(HeaderRow_A, i).Value), i 'if does not exist record name as KEY and Column number as value in dictionary
End If
Next i
End With
With ws_B 'worksheet you want to paste data into
ws_B_lastCol = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column ' Get number of DATA you have in sheet B
For i = 1 To ws_B_lastCol 'for each data
SourceCol_A = NameList_A(UCase(.Cells(1, i).Value)) 'get the column where the name is in Sheet A from the dictionaary
If SourceCol_A <> 0 Then 'if 0 means the name doesnt exists
SourceLastRow = ws_A.Cells(Rows.Count, SourceCol_A).End(xlUp).Row
Set Source = ws_A.Range(ws_A.Cells(SourceDataStart, SourceCol_A), ws_A.Cells(SourceLastRow, SourceCol_A))
NextEntryline = .Cells(Rows.Count, i).End(xlUp).Row + 1 'get the next entry line of the particular name in sheet A
.Range(.Cells(NextEntryline, i), _
.Cells(NextEntryline, i)) _
.Resize(Source.Rows.Count, Source.Columns.Count).Cells.Value = Source.Cells.Value
End If
Next i
End With
End Sub

Insert copied cells from one sheet to another sheet

I want to copy all rows that have a specific value in column E and then insert them (NOT PASTE! so i want to insert new rows start at cell A29) on another sheet.
The sheet I want to copy from is called "owssvr" and the one I want to copy to is called "AOB Approval Form". I want to insert the copied rows starting Cell A29 in the "AOB Approval Form".
When i run the code, nothing happens. No error message pops up.
Few definition of my code below:
LastRow: The last row of the "owssvr" sheet
PrimaryAOB: value that i want to lookup for in column 5. It is on the "AOB Approval Form" sheet
Here is my code:
For k = 2 To lastRow
If Worksheets("owssvr").Range("E" & k).Value = primaryAOB Then
Worksheets("owssvr").Rows(k).Copy
Worksheets("AOB Approval Form").Rows(k + 27).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
Next k
THANK YOU!
I copied your code into a new module in a blank workbook, then made the necessary mods to make it run (which it did). It looks the same as yours:
Sub Question()
Dim k As long, lastRow As Long
Dim primaryAOB As String
lastRow = Sheets(1).Range("E" & (ActiveSheet.Rows.Count)).End(xlUp).Row
primaryAOB = Sheets(2).Range("A1").Text
For k = 2 To lastRow
If Worksheets("owssvr").Range("E" & k).Value = primaryAOB Then
Worksheets("owssvr").Rows(k).Copy
Worksheets("AOB Approval Form").Rows(k + 27).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
Next k
End Sub
Since this worked, you may have just had some little syntax error somewhere while defining the variables. show us more of your procedure, that may reveal the issue! Also, have you run your code line by line? (F8)

How to move entire row based on text in a single cell?

I have been searching on the internet where to find the most efficient and simple way of the following:
I have a spreadsheet that contains 3 sheets:
information
training
Leavers
Within the information sheet, column B contains a validation text that is conditionally formatted. There are two validation options:
Active
Leaver
I want that once the cell value is changed from 'active' to 'Leaver' that the whole row would be removed from the sheet and moved to 'Leaver's sheet.
I have used the code below, it works, however if there is no Leavers it will transfer the first row of 'active'. Can anyone tell me what is the problem?
Sub AlexR688(x)
'For http://www.mrexcel.com/forum/excel-q...ific-text.html
'Using autofilter to Copy rows that contain centain text to a sheet called Errors
Dim LR As Long
Range("B2").EntireRow.Insert Shift:=xlDown
LR = Sheets("Personal Information").Cells(Rows.Count, "B").End(xlUp).Row
LR1 = Sheets("Leavers").Cells(Rows.Count, "B").End(xlUp).Row + 1
With Sheets("Personal Informaiton").Range("B2:C" & LR)
.AutoFilter
.AutoFilter Field:=1, Criteria1:="Leaver", _
Operator:=xlOr, Criteria2:=":Leaver"
.SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=Sheets("Leavers").Range("A" & LR1)
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub
Secondly, I want to make the same in the 'Training' sheet. But in there, column B, contains the same 'Active', 'Leavers' which is referenced from personal information. So, once the Personal information sheet column B is changed from 'active' to 'leaver', training sheet will change as well, but i want the row in the training sheet would be deleted.
Thirdly, if I accidentally moved row from Personal information sheet to Leavers sheet, is it possible that by selecting back to 'active' cell value the row would move back to where it was?
Thank you very much. Hope it is clear enough.
this is the easiest way
Private Sub imperecheaza_Click()
Dim ws As Worksheet
Dim Rand As Long
Set ws = Worksheets("BD_IR")
Rand = 3
Do While ws.Cells(Rand, 4).Value <> "" And Rand < 65000
If ws.Cells(Rand, 4).Value = gksluri.Value * 1 And ws.Cells(Rand, 5).Value = gksluri.List(gksluri.ListIndex, 1) * 1 Then
ws.Rows(Rand) = "" '(here you will delete entire Row)
gksluri.RemoveItem gksluri.ListIndex
Exit Do
End If
Rand = Rand + 1
Loop
End Sub

Need to summarize data from multiple excel worksheets onto one summary page

I'm trying to create a yearly summary for some of our transfers. Essentially, I have 12 sheets, one for each month of the year, and each entry is given one of four specific "Transfer Rationales" in column L. I need to be able to create a worksheet that gives me a running year-to-date summary based on each transfer rationale.
So say, for example, the transfer rationale I'm looking at is called "Incorrectly Assigned" - I think need to have the summary page show columns G-K of each row where column L is "Incorrectly Assigned" from all twelve month sheets.
I've been looking at VBA code and trying to tweak some to work, but I could use some help!
EDIT:
Obviously it's not working as I need or I wouldn't be here, but I don't have much knowledge about VBA. I have something here where the code is grabbing the entries where column L met the criteria, but it was
a) copying all the columns, and I only need G-K to paste, and
b) was putting the copied rows all in one row in the summary tab, so I could see the data for a split second, and then it would overwrite with the next line and so on until it finally settled on the last entry found.
SECOND EDIT:
So I have a code that now (mostly) works, I've pasted it below and deleted the old code above.
Private Sub CommandButton1_Click()
Dim WkSht As Worksheet
Dim r As Integer
Dim i As Integer
i = 1
For Each WkSht In ThisWorkbook.Worksheets
i = i + 1
If WkSht.Name <> "Incorrectly Assigned" Then
For r = 1 To 1000
If WkSht.Range("L" & r).Value = Sheets("Incorrectly Assigned").Range("A1").Value Then
WkSht.Range("E:L").Rows(r & ":" & r).Copy
Sheets("Incorrectly Assigned").Range("E:L").End(xlUp).Offset(i, 0).PasteSpecial Paste:=xlPasteValues
End If
Next r
End If
Next WkSht
End Sub
The problem now is that it is only grabbing the last match from each worksheet - so say January has four matching entries, it's only pasting the fourth entry, then the next row down it'll paste the last entry from February etc. and then if there's an entry in say November that matches, it'll be pasted in the 11th row from the beginning, rather than each entry being pasted one after another.
Better to create a sub-routine that you call from your "CommandButton1". Then you can call the procedure from more than one location. You can also generalize it by using an input parameter 'transferID' which defines the summary you want.
Private Sub CommandButton1_Click()
Call PrintSummary("Incorrectly Assigned")
End Sub
It will likely need some tweaking to get it how you want, but this should give you some ideas to get you started:
Sub PrintSummary(transferID As String)
Dim ws As Excel.Worksheet
Dim wso As Excel.Worksheet
Dim lrow As Long
Dim rng As Excel.Range
Dim rngo As Excel.Range
Dim cell As Excel.Range
Dim colH As Variant
Dim i As Integer
'// Define columns for output
colH = Array("G", "H", "I", "J", "K")
'// Check for summary sheet (for output)
On Error Resume Next
Set wso = ThisWorkbook.Worksheets("Summary")
On Error GoTo 0
If wso Is Nothing Then
'// Summary worksheet does not exist :/
Exit Sub
Else '// format worksheet for output
'// for example...
wso.Cells.Delete Shift:=xlUp
Set rngo = wso.Range("A1") '// define output start
Set wso = Nothing
End If
'// Loop through worksheets
For Each ws In ThisWorkbook.Worksheets
'// Check for valid worksheet name
Select Case VBA.UCase(ws.Name)
Case "JAN", "FEB" '// and so forth...
Set rng = ws.Range("L1")
Set rng = ws.Range(rng, ws.Cells(Rows.Count, rng.Column).End(xlUp))
For Each cell In rng
If (VBA.UCase(cell.Text) = VBA.UCase(transferID)) Then
'// Print meta data
rngo.Offset(lrow, 0).Value = ws.Name
rngo.Offset(lrow, 1).Value = transferID
'// Print values
For i = 0 To UBound(colH)
rngo.Offset(lrow, i + 2).Value = ws.Cells(cell.Row, VBA.CStr(colH(i))).Value
Next i
'// Update counter
lrow = lrow + 1
End If
Next cell
Case Else
'// Not a month? do nothing
End Select
Next ws
End Sub
You do not need VBA - just refence the cell in the other tab:
SheetName!CellAddress
Precede the cell address with the worksheet name, and follow it with an exclamation point.
If you need VBA, then I have understood your question incorrectly.
EDIT:
Lets start with problem B:
was putting the copied rows all in one row in the summary tab
Lets look at the code you use to paste values:
Sheets("Summary").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Here you always paste everyting in the same place, in cell A65536 which you offset by one. On every iteration of your loop, the values will be at the same place. Change the Offset(1) to
Offset(0, r)
Now on every iteration you will paste on a different row, because r will be 1, 2, ..., 1000. See MSDN for documentation on Offset. Select a values that accomplished a paste the way you need.
Lets go to the next question:
a) it was copying all the columns
I will edit once the first part works as it should for you.

Copy multiple rows from one worksheet to another worksheet using macro/vba

I've looked around the forum and played with various options but not found a clear match for my problem:
My task is to copy data from a worksheet (called “workorders”) to a second worksheet (called “Assignments”). The data to be copied is from the “workorders” worksheet starting at cell range “E2, P2:S2”; and also copied from each row (same range) until column “P” is empty – (the number of rows to be copied can vary each time we need to run this macro so we can’t select a standard range) . Then pasted into the “Assignments” worksheet, starting at cell “A4”. I’ve used the forum so far to successfully copy a single row of date (from row 2) – I admit that’s the easy part, and I’ve used various versions of code to achieve this.
I’ve also tried some code (which I found via watching a youtube clip and modifying http://www.youtube.com/watch?v=PyNWL0DXXtQ )to allow me to run a loop which repeats the copy process for each required row in the “workorders” worksheet and then pastes the data into the “assignments” worksheet- but this is where I am not getting it right, I think I’m along the right lines and think I’m not far off but any help would be very useful.
Code examples below (first 2 only copy first row, 3rd example is where I’ve tried to loop and copy multiple rows:
Sub CopyTest1()
' CopyTest1 Macro
'copy data from workorders sheet
'Worksheets("workorders").Range("E2,P2,Q2,R2,S2").Copy
Worksheets("workorders").Range("E2, P2:S2").Copy
'paste data to assignments sheet
'sheets("assigments dc").Range("A4").Paste
Sheets("Assigments DC").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Sub CopyTest2()
Sheets("workorders").Range("e2,p2,q2,r2,s2").Copy Sheets("assigments dc").Range("a4")
End Sub
Sub CopyTest3()
Dim xrow As Long
'Dim xrow As String
xrow = 2
Worksheets("workorders").Select
Dim lastrow As Long
lastrow = Cells(Rows.Count, 16).End(xlUp).Row
Do Until xrow = lastrow + 1
ActiveSheet.Cells(xrow, 16).Select
If ActiveCell.Text = Not Null Then
'Range("E2,P2,Q2,R2,S2").Copy
'Selection = Range("E2,P2,Q2,R2,S2").Copy
'Cells(xrow, 5).Copy
Cells(xrow, 5).Copy
Sheets("Assigments DC").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("workorders").Select
End If
xrow = xrow + 1
Loop
End Sub
Try this:
Sub LoopCopy()
Dim shWO As Worksheet, shAss As Worksheet
Dim WOLastRow As Long, Iter As Long
Dim RngToCopy As Range, RngToPaste As Range
With ThisWorkbook
Set shWO = .Sheets("Workorders") 'Modify as necessary.
Set shAss = .Sheets("Assignments") 'Modify as necessary.
End With
'Get the row index of the last populated row in column P.
'Change accordingly if you want to use another column as basis.
'Two versions of getting the last row are provided.
WOLastRow = shWO.Range("P2").End(xlDown).Row
'WOLastRow = shWO.Range("P" & Rows.Count).End(xlUp).Row
For Iter = 2 to WOLastRow
Set RngToPaste = shAss.Range("A" & (Iter + 2))
With shWO
Set RngToCopy = Union(.Range("E" & Iter), .Range("P" & Iter & ":S" & Iter))
RngToCopy.Copy RngToPaste
End With
Next Iter
End Sub
Read the comments first and test.
Let us know if this helps.
From what I see, you are only copying the cell in Column E. You could correct this by replacing Cells(xrow, 5).Copy with
Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Copy
However, using Select and Copy are not ideal. Instead, you can assign the value of the range directly:
Sheets("Assignments DC").Range("A4").Value = Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Value
More info on the Union method and why using Select is bad.
Is it even possible to run a line like this?
Worksheets("workorders").Range("E2, P2:S2").Copy
Each time I try different ways to copy/select a range which contains in my case, A3 and the range A34:C40 ("A3, A34:C40").Copy i get an error saying theres to many parameters.. Could this be because I'm running excel 2007?
Any tips or help would be greatly apreciated! :)