Got help from you guys to create a code to copy some value from one workbook to another. I have one more question though.
I would like to write som static information in a cell in column J on the same row as the other copied information.
How do I add that to the loop?
I´ve tried:
wsDest.Cells(DestRow, "J").Value = "HVD"
But it only adds the value in the first row not the rest. No errors but it seems as it doesn't loop as the other code inside the For Each.
Option Explicit
Public Sub CopyCells()
Dim wsSrc As Worksheet 'define source sheet
Set wsSrc = ThisWorkbook.Worksheets("Blad1")
Dim wbDest As Workbook 'define destination workbook
Set wbDest = Workbooks.Open("C:\Temp\Ändringar bef objekt.xlsx")
Dim wsDest As Worksheet 'define destination sheet
Set wsDest = wbDest.Worksheets("Ändringsdata")
Dim DestRow As Long
DestRow = 2 'start in row 2 in destination sheet
wsSrc.Parent.Activate: wsSrc.Activate
Dim Rng As Range
For Each Rng In Selection.Areas
Rng.Resize(, 1).Copy Destination:=wsDest.Cells(DestRow, "A") 'copy A to A
Rng.Resize(, 1).Offset(, 5).Copy Destination:=wsDest.Cells(DestRow, "D") 'copy F to D
**wsDest.Cells(DestRow, "J").Value = "HVD" 'write HVD in column J same row**
DestRow = DestRow + Rng.Rows.Count 'move DestRow to next free row
Next Rng
End Sub
I think you misunderstand how your For Each works. It doesn't loop through every row or every cell. It loops through Areas, which is a collection of Ranges. Usually there's only one Range in this collection, but if you select cells with Ctrl then you have more elements in Areas.
So, your code takes one such "Area" and copy it's first column to column A, then it's 5th column to column D and enters "HVD" into a single cell (Cells(DestRow, "J")). If you want to enter this value in every row you must resize this cell. And to do this you can use this:
wsDest.Cells(DestRow, "J").Resize(Rng.Rows.Count).Value = "HVD"
Also, remember that you can debug your code by putting cursor inside your macro code and pressing F8. This will run your code line by line and all changes will be immediately seen in the worksheet.
Related
I have to do this excel sheet at work and I'm kindof stuck at this problem.
I need to create a list in sheet 3 with the items that have been selected in sheet 2 (valid selection is when Quantity is equal or greater then 1).
So that in the cells in sheet 3 only the items requested appear and the quantity desired.
I was going to try and use a filter function but I cannot use that because I must use Excel 2016 which does not have it.
I have attached 2 screenshots to better illustrate my problem.
Thanks in advance. (Image 1) (Image 2)
It is easier to create a macro.
ALT + F11 and copy and paste the text below in a module. You can modify the rng and other variables if you want.
Public Sub copy_quantity()
Dim ws As Worksheet
Dim ws_copy As Worksheet
Dim rng As Range
Dim lr As Long
Set ws = ThisWorkbook.Sheets("Dati Richiesti") 'The source worksheet
Set ws_copy = ThisWorkbook.Sheets("Ripilogo Richiesti") 'destination worksheet
Set rng = ws.Range("C6:C600") 'The range to check quantity
'Now loop through all quantities
For Each cell In rng
If cell > 0 Then
lr = ws_copy.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'Determine where to paste on the first empty row
ws.Range(cell.Offset(0, -1), cell.Offset(0, 1)).Copy Destination:=ws_copy.Range("a" & lr) ' copy paste from one sheet to the other
End If
Next ' check the following cell for the quantity
End Sub
I want to make variable C into the selection cell
like this
Dim c= selection area
I tried this code:
ActiveCell.Value
but doesnt' working..
Selcetion cell is always change.. so can't use range(null:null)
Sub noname1()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim B As String
Dim C
B = Cells(20, 87).Value
C = Selection
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("source.xlsx").Worksheets("5.588")
Set wsDest = Workbooks("dest.xlsx").Worksheets(B)
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range(C).Copy _
wsDest.Range("A" & lDestLastRow)
'Optional - Select the destination sheet
wsDest.Activate
End Sub
A "Range" can be a single cell or any number of cells together. Since all cells are on one sheet or another every range is on a sheet as well. A range can't include cells from more than one sheet.
All sheets are in workbooks. No sheet can be in more than one workbook. Therefore no range can be spread over more than one workbook.
To specify a range you need to tell the workbook, the worksheet, its first cell and its last cell. If you don't specify the workbook the ActiveWorkbook will be presumed. If you don't specify the worksheet, the ActiveSheet will be presumed. Therefore
Range("B5:D15")
' is the same as
Activeworkbook.ActiveSheet.Range("B5:D15")
You don't need to select a range in order to copy, clear, delete or modify it. VBA's Selection object supports the user's selection on the screen but otherwise largely mirrors the Range object which disregards the screen. Therefore, if you select B5:D15 and enter ? Selection.Address(0,0) in the Immediate pane the answer will be "B5:D15". You will get the same reply if you enter ? Range("B5:D15").Address(0,0).
In my example, B5 and D15 are the first and last cells of the range. Excel creates a range name from these coordinates which is presented in inverted commas because it's a string. However, you can also specify the same cells as members of the Cells collection (all cells in a range - by default the entire sheet).
Debug.Print Range("B5:D15").Address
Debug.Print Range(Cells(5, 2), Cells(15, 4)).Address
The two lines of code print the same response but the second one is much easier to create using variables, such as changing row or column numbers.
So, now you can see what the code below would do.
Range(Cells(5, 2), Cells(15, 4)).Copy Destination:=Sheet2.Cells(1, 1)
I'm having an Excel Spreadsheet with 3 sheets inside and I need to copy certain cell range from Sheet1 and copy it to Sheet2.
And I'm trying to get the range of cells to be copied as an input in a cell that is available in Sheet 3. Like the cell would have value A4:X6 in it. But I'm unable to get the input values passed on to the Range function in my Macro code.
Below is my code and when I execute, it just enters an empty row in the Sheet 2
Sub CopyData()
Sheet3.Select
Set Range1 = Range(Cells(3, 3).Value)
Sheet1.Select
Range1.Copy
Sheet2.Select
Range("A2").Select
Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
I want the contents of cell denoted in Range1 to be copied from Sheet1 and pasted in Sheet2.
Thank you in advance!
John Coleman is right you can avoid using Select for the whole subroutine. But, your problem here is when you define the range it is defining it specifically for Sheet3 and not Sheet1. One alternative is you could store the address in a string that gets passed to the Range() function, but specify which sheet you want your range to reflect. The rest of the code can be handled much the same without using Select.
Sub CopyData()
Dim range1 as Range
dim strRange as String
strRange = Sheet3.Cells(3, 3).Value
Set range1 = Sheet1.Range(strRange)
range1.Copy Sheet2.Range("A2")
Sheet2.Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
Use Set Range1 = Sheet3.Range(Cells(3, 3).Value) instead of Set Range1 = Range(Cells(3, 3).Value) or the range get selected from sheet1 because of Sheet1.Select
when i execute, it just enters an empty row in the Sheet 2 Of course it does. Your code does exactly that. Line Range("A2").EntireRow.Insert Shift:=xlShiftDown creates the row. There is nothing in your code that pastes the content of range A4:X6 ot whatever input you got in the cell.
Actually, if you delete your code and leave it like this:
Sub CopyData()
Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
You will get the same, a new row inserted.
I want the contents of cell denoted in Range1 to be copied from Sheet1 and pasted in Sheet2
I guess you are trying to copy a specific range, not a whole row and paste it, you need something like this:
Sub CopyData()
Dim Range1 As Range
Set Range1 = Sheet1.Range(Sheet3.Cells(3, 3).Value)
Range1.Copy
Sheet2.Range("A2").PasteSpecial (xlPasteAll) 'this command will paste the contents
End Sub
This example shows how to insert a line above line 2, copied to the format of the line down (line 3) and from the header line
Range("2:2").Insert CopyOrigin:=xlFormatFromRightOrBelow
As you understood, .Insert will always insert blank row.
I guess that you would like to paste a range in your sheet and not insert a new row for this you should do like this :
Sheets("SheetName").Range("A2").PasteSpecial (xlPasteAll)
Also note that xlPasteAll is an XlPasteType as xlPasteFormats , xlPasteValues and so on.
xlPasteAll will paste all
xlPasteFormats will paste the source format
xlPasteValues will paste the value
So your code would be as below :
Sub CopyData()
Dim Range1 As Range
Dim Range2 As Range
Set Range1 = Sheet1.Range(Sheet3.Cells(3, 3).Value)'Will define the range you want to copy
Range1.Copy 'here you copy the range
Set Range2 = Sheet2.Range("A2") 'Set the range where you want to paste data
Range2.PasteSpecial (xlPasteValues) 'then you will paste your range
End Sub
Click here to get the list of those XlPasteType
BONUS
Sheet2.Select
Range("A2").Select
is the same as
Set Range2 = Sheet2.Range("A2")
But the last way is better because it avoid Select which can slow down your performances !
Is there a specific requirement for inserting the copied data at the top or would you be happy adding it to the end of the "list" instead? If so, you could find the last used row and add it at the bottom instead like this:
Sub CopyFromSheet1toSheet2()
Dim thisBook As Workbook: Set thisBook = ThisWorkbook
Dim sheetOne As Worksheet: Set sheetOne = thisBook.Worksheets("Sheet1")
Dim sheetTwo As Worksheet: Set sheetTwo = thisBook.Worksheets("Sheet2")
Dim copyFromRange As Range: Set copyFromRange = sheetOne.Range("A4:X6")
Dim lastRow As Long: lastRow = sheetTwo.Cells(Rows.Count, 1).End(xlUp).Row
Dim pasteToRange As Range: Set pasteToRange = sheetTwo.Range("A" & lastRow)
copyFromRange.Copy Destination:=pasteToRange
End Sub
"lastRow" returns the numeric value of the last used row in a given column. If you have data in A1:A4 then this code would add the next lot of data copied to A5 and below.
I need any row in Sheet1 that has the word 'Done' in column E to be cut and pasted into the next empty row of Sheet2. My problem is that I don't know how to find the next empty row in Sheet2 and start pasting values to that next empty row.
It's a basic Workbook with two Sheets. Sheet1 has all employee tasks and Sheet2 only displays the tasks that are 'Done'. Anytime an employee finishes a task and types 'Done' in a cell within Column E of Sheet1, that entire row needs to be cut and pasted into the next empty row of Sheet2. I created an ActiveX Command button in Sheet1 with the following code. The code finds any cell in Sheet1 that says 'Done' and cuts/pastes it in Sheet2, but it always starts pasting from the beginning of Sheet2, and I need it to start pasting from the next empty row of Sheet2.
Private Sub CommandButton1_Click()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "Done" Then
Source.Rows(c.Row).Cut Target.Rows(j)
j = j + 1
End If
Next c
End Sub
My problem is that it keeps overwriting anything that's already in Sheet2 because I don't know what to replace that 'j' variable code with. I need it to find the next empty row in Sheet2 and start pasting from there.
Give this a go:
Private Sub CommandButton1_Click()
Dim Source As Worksheet
Dim Target As Worksheet
Dim lRowSrc As Long, lRowDst As Long, lColSrc As Long, R As Long
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
With Source
lRowSrc = .Cells(.Rows.Count, 1).End(xlUp).row
lColSrc = .Cells(1, .Columns.Count).End(xlToLeft).Column
For R = lRowSrc To 1 Step -1
If .Cells(R, 5) = "Done" Then
lRowDst = Target.Cells(Target.Rows.Count, 1).End(xlUp).row
Target.Range(Target.Cells(lRowDst + 1, 1), Target.Cells(lRowDst + 1, lColSrc)).Value = .Range(.Cells(R, 1), .Cells(R, lColSrc)).Value
.Cells(R, 5).EntireRow.Delete 'get rid of the row
End If
Next R
End With
End Sub
Keep in mind that with a large data set, this aproach is not ideal, and using arrays is much much better. If however you only have a small number of rows (assume so...), it should be fine.
EDIT: used last row variable instead of the current row for copying values. Fixed.
I have an excel file like
Original File
I want to transform all the cells that filled with information into a single column. Like
To transform This
How to i do this ?
I searched in internet about that i found just only transform cells in a single row to a single cell. But i couldn't find anything like this. Can you help me about that
This is a bit of code I keep around for this kind of job. It assumes that the values in each row are contiguous, that is there are no blank cells inside the data set. It also assumes that you're on the sheet that contains the data when you trigger it, and that you want the data to be placed on a new worksheet.
Option Explicit
Sub Columnise()
Dim shtSource As Worksheet
Dim shtTarget As Worksheet
Dim rngRow As Range, rngCol As Range
Dim lCount As Long
Set shtSource = ActiveSheet 'Or specify a sheet using Sheets(<name>)
Set rngCol = Range("A1", Range("A" & Rows.Count).End(xlUp))
Set shtTarget = Sheets.Add 'Or specify a sheet using Sheets(<name>)
'Define starting row for the data
lCount = 1
'Loop through each row
For Each rngRow In rngCol
'On each row, loop through all cells until a blank is encountered
Do While rngRow.Value <> ""
'Copy the value to the target
shtTarget.Range("A" & lCount).Value = rngRow.Value
'Move one space to the right
Set rngRow = rngRow.Offset(0, 1)
'Increment counter
lCount = lCount + 1
Loop
Next rngRow
End Sub
You should end up with all the data in a single column on a new worksheet.
EDITED TO ADD: Since you mentioned your data does contain blank cells, it gets more complicated. We'll want to add a way to continue to the actual end of the data, rather than just looping until we hit a blank cell. We'll modify the Do While... condition to this:
Do While rngCell.Column <= Cells(rngCell.Row, Columns.Count).End(xlToLeft).Column
This will loop until the end of the data in the row, then move on. Give it a shot and let us know.