Is it possible to transfer specific data from one worksheet to another?
What I want to do is to find all the data that has a specific string and transfer it to other worksheet. For example, I want to find data that has AC in it using the MID function, without any regards to its column and row, and transfer it to another worksheet.
So far, all I know is you need to have a specific range just like this code for it to work:
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For Each MyCell In Range("E2:E" & LastRow)
MyCell.Value = Mid(Range("A" & MyCell.Row), 6, 2)
Next
But the thing is it only searches a certain column, what I want is to search all the data inside a worksheet. Is this possible?
The main idea is to find / search something in this worksheet that correspond to a certain criteria.
get the data.
transfer it to another worksheet.
Something like this might help you out. You may have to tweak it to your suitability.
Sub TransferAC()
Dim C As Range
For Each C In Worksheets("Sheet1").Range("A1:B3").Cells
If InStr(1, LCase(C.Value), "ac", vbTextCompare) > 0 Then
Worksheets("Sheet2").Range(C.Address).Value = C.Value
End If
Next
End Sub
To test this, create Sheet1 like so (and create an empty Sheet2):
A B
1 testing racing
2 fencing dashing
3 pacing sleeping
When you run the procedure, Sheet2 will have
A B
1 racing
2
3 pacing
EDIT
If columns and rows are unknown but we know that they start from A1, simulate doing CTRL+DOWN-arrow-key to get the last non-empty cell in the same column and CTRL+RIGHT-arrow-key from A1 to get the last non-empty cell to the right. That will be assumed as the non-empty range.
Sub TransferAC()
Dim RangeString As String
Worksheets("Sheet1").Select
Range("A1").End(xlDown).Select
RangeString = Selection.Address
Range("A1").End(xlToRight).Select
RangeString = RangeString & ":" & Selection.Address
Dim C As Range
For Each C In Worksheets("Sheet1").Range(RangeString).Cells
If InStr(1, LCase(C.Value), "ac", vbTextCompare) > 0 Then
Worksheets("Sheet2").Range(C.Address).Value = C.Value
End If
Next
End Sub
The other alternative is to give range from A1:XFD1048576 (all cells), but that may become impractical to use.
Related
Well I have done a lot of research and found a lot of relevant questions and answers but couldn't quite figure out how to cater that information to my specific need.
I am working on a project to create a macro that will correct mistakes and fill in information commonly found in product catalogs that I work with.
One thing I am trying to accomplish is to give the value "unassigned" to each blank cell in a row that is marked "Y" in column B.
I've found out how to change every cell in those particular rows and have it adjust dynamically to the number of rows. What I can't figure out is how to do the same for the number of columns. In my code below everything between columns B and S is included. Column B will always be in the same spot but column S will not always be the last column.
Dim tracked As String
Dim endCell As Range
Dim endRow As Long
Dim endColumn As Long
Dim start As Long
endRow = ActiveSheet.Range("D2").End(xlDown).Row
endColumn = ActiveSheet.Range("A1").End(xlToRight).Column
Let tracked = "B2:" & "B" & endRow
Set trackItem = ActiveSheet.Range(tracked)
For Each y In trackItem
If Left(y.Value, 1) = "Y" Then
'start = y.Row
'Set endCell = ActiveSheet.Cells(endColumn, start)
ActiveSheet.Range("B" & y.Row & ":" & "S" & endColumn).Value = "Unassigned"
End If
Next y
I included some code that I've left commented out so you can see what I've tried.
So, I can successfully change the value of all cells within that range but I need to know how to do it with a range where the number of columns will not always be the same. In addition, I want to select the blank cells only within this range and assign them a value. I imagine this will need to be done row by row as the correct criteria will not always be together.
I'm surprised more people don't use 'UsedRange' when there is a need to loop through all the cells that have data on a sheet. (Just yesterday someone was complaining that it takes too long to loop through all 17,179,869,184 cells on a worksheet...)
This example lists & counts the "used" range, and will easily adapt to your needs.
Sub List_Used_Cells()
Dim c As Range, x As Long
For Each c In ActiveSheet.UsedRange.Cells
Debug.Print c.Address & " ";
x = x + 1
Next c
Debug.Print
Debug.Print " -> " & x & " Cells in Range '" & ActiveSheet.UsedRange.Address & "' are considered 'used'."
End Sub
I populated an excel sheet with the locations of blank cells in my sheet using suggestions from this post. So I have a Column A filled with locations in the following format
$X$1 or $X2:$X$4.
What I am trying to do is use those row numbers from the column explain above to populate a separate column. I want to use the row numbers as a reference in what to populate for the column. So a Column B looking something like
=$B$1 or =$B$2:$B$4 (took 1 and 2-4 and used it as row number for reference call)
Both columns are referencing a different sheet so please excuse any column naming.
I'm not sure if this is going to require VBA or if I can get away with just using a formula, I expect VBA due to desired specifics. I've looked at post like this and this. But neither of these fully encompass what I'm looking for. Especially since I want it to express all the contents in a $B$2:$B$4 case.
My intuition on how to solve this problem tells me, parse the string from Column A for the 1st number then check if it's the end of the string. If it is, feed it to the reference that populates Column B, if not then find the 2nd number and go through a loop that populates the cell (would prefer to keep all the content in one cell in this case) with each value for each reverence.
i.e.
=$B2
=$B3
=$B4
My question is how do I go about this? How do I parse the string? How do I generate the loop that will go through the necessary steps? Such as using the number as a reference to pull information from a different column and feed it neatly into yet another column.
If (for example) you have an address of $X2:$X$4 then
Dim rng As Range
Set rng = yourSheetReference.Range("$X2:$X$4")
If you want to map that to the same rows but column B then
Set rng = rng.Entirerow.Columns(2)
will do that. note: it's not so clear from your question whether you're mapping X>>B or B>>X.
Once you have the range you want you can loop over it:
For Each c in rng.Cells
'do something with cell "c"
next c
Something like this should work for you:
Sub Tester()
Dim shtSrc As Worksheet, c As Range, rng As Range, c2, v, sep
Set shtSrc = ThisWorkbook.Worksheets("Sheet1") '<< source data sheet
Set c = ActiveSheet.Range("A2") '<<range addresses start here
'process addresses until ColA is empty
Do While c.Value <> ""
'translate range to (eg) Column X
Set rng = shtSrc.Range(c.Value).EntireRow.Columns(24)
sep = ""
v = ""
'build the value from the range
For Each c2 In rng.Cells
v = v & sep & c2.Value
sep = vbLf
Next c2
c.Offset(0, 1) = v '<< populate in colB
Loop
End Sub
Try this code:
Sub Test()
Dim fRng As Range ' the cell that has the formula
Set fRng = Worksheets("sheet1").Range("A1")
Dim tWS As Worksheet 'the worksheet that has the values you want to get
Set tWS = Worksheets("sheet2")
Dim r As Range
For Each r In Range(fRng.Formula).Rows
'Debug.Print r.Row ' this is the rows numbers
Debug.Print tWS.Cells(r.Row, "N").Value 'N is the column name
Next
End Sub
Hello stackoverflow community,
I must confess I primarily code within MS Access and have very limited experience of MS Excel VBA.
My current objective is this, I have an expense report being sent to me with deductions in another countries currency, this report has many columns with different account names that may be populated or may be null.
I currently have a Macro that will open an input box and ask for the HostCurrency/USD Exchange rate, my next step will be to start at on the first record (Row 14; Column A-K contains personal info regarding the deduction) then skip to the first deduction account (deduction accounts start at column L and span to column DG) checking if each cell is null, if it is then keep moving right, if it contains a value then I want to multiply that value by my FX rate variable that was entered in the input box, and update the cell with the converion. Once the last column (DG) has been executed I want to move to the next row (row 15) and start the process again all the way until the "LastRow" in my "Used Range".
I greatly appreciate any feedback, explanations, or links that may point me towards my goal. Thank you in advance for taking the time to read though this!
First off, you really should attempt to write the code yourself and post what you have so someone can try to point you in the right direction. If your range is going to be static this is a very easy problem. You can try something along the lines of:
Sub calcRate(rate As Double, lastrow As Integer)
Dim rng As Range
Set rng = Range("L14" & ":DG" & lastrow)
Dim c As Variant
For Each c In rng
If c.Value <> "" Then
c.Value = c.Value * rate
End If
Next
End Sub
This code will step through each cell in the given range and apply the code without the need for multiple loops. Now you can call the calcRate sub from your form where you input the rate and lastrow .
This will do it without looping.
Sub fooooo()
Dim rng As Range
Dim mlt As Double
Dim lstRow As Long
mlt = InputBox("Rate")
With ActiveSheet
lstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(14, 12), Cells(lstRow, 111))
rng.Value = .Evaluate("IF(" & rng.Address & " <>""""," & rng.Address & "*" & mlt & ","""")")
End With
End Sub
If your sheet is static you can replace ActiveSheet with WorkSheets("YourSheetName"). Change "YourSheetName" to the name of the sheet.
At the moment I’m only able to copy&paste stuff from one row.
I use the code below:
Dim lastRow As Long
With Sheets("Tab1")
If Application.WorksheetFunction.CountA(.Columns(3)) <> 0 Then
lastRow = .Cells(Rows.Count, "C").End(xlUp).Row + 1
Else
lastRow = 1
End If
Sheets("Tabelle2").Range("B85:S85").copy
.Range("C" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
My problem is that I need to copy and paste lists. Can someone show me how to use this code to copy&paste lists?
I wanted to copy more rows, like (A25:S25, A27:S27, A30:S30)
It should copy always the same rows.
There are two reasons for your code copying just one row:
The code selects just one row to copy
Sheets("Tabelle2").Range("B85:S85").Copy
The select just on row to Paste
.Range("C" & lastRow).PasteSpecial Paste:=xlPasteValues …
As it’s not clear if you want to copy several rows despite selecting just one or to copy that one row to several rows I’ll cover both options in order to give you an idea of what to do in both cases:
Setting the range to be copied
a. To copy just range B85:S85 one row only then what you are doing is correct
Wbk.Sheets("Tabelle2").Range("B85:S85")
b. To copy X rows down from row 85 (including row 85)
Wbk.Sheets("Tabelle2").Range("B85:S85").Resize(X)
c. To copy Y rows up from row 85 (including row 85)
Wbk.Sheets("Tabelle2").Range("B85:S85").Offset(1-Y, 0).Resize(Y)
d. To copy the range bounded by any combination of blank rows and blank columns in which "B85:S85" is included (see Range.CurrentRegion Property (Excel))
Wbk.Sheets("Tabelle2").Range("B85:S85").CurrentRegion
Note that this will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards and it will also include any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
This procedure demonstrates the options explained above:
Sub Range_Set()
Dim rSrc As Range
With ThisWorkbook.Sheets("Tabelle2")
'If want to copy just this row 85
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85")
rSrc.Select: Stop
'If want to copy 5 rows down from row 85 (including row 85)
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").Resize(5)
rSrc.Select: Stop
'If want to copy 5 rows up from row 85 (including row 85)
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").Offset(-4, 0).Resize(5)
rSrc.Select: Stop
'If want to copy then range bounded by any combination of blank rows and blank columns in which "B85:S85" is included
'This will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards
'Also will include also any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").CurrentRegion
rSrc.Select: Stop
End With
End Sub
Setting the range where the copy takes place
To copy the source range as it is, then just need to select the first cell of your target range and the paste.special will cover paste the target to all cells required as per the size all target cell. However is you want to copy range B85:S85’ to several cell then you need to select the target rows. For example if we want to copyB85:S85’ over five rows starting at C5 then we need to set the target range as
.Range("C12").Resize(5).PasteSpecial Paste:=xlPasteValues
As we are going to copy only the values of the source, I suggest to use the Range.Value property of the Range object instead of the Copy…Paste method. One advantage of using this property is to avoid the use of the Clipboard.
Try this code (select\adjust the options as per your requirements)
Sub Range_Value()
Dim Wbk As Workbook
Dim lastRow As Long
Dim rSrc As Range
Rem Declare Objects
Set Wbk = ThisWorkbook 'use this if procedure is resident in the wbk with the tables
'Set Wbk = Workbooks(WbkName) 'use this if procedure is not resident in the wbk with the tables - update wbk name
With Wbk.Sheets("Tab1")
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Rem Set Copy Range
'since we are going to paste only values then we can save us from using the clippboard
'Sheets("Tabelle2").Range("B85:S85").Copy
'instaed create a range to replace the values of the target range with the values of this range
'Uncomment\Update the option needed according to you requirements
'for this test I'm using option b
'a. To copy just row 85
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85")
'b. To copy X rows down from row 85 (including row 85) X=5
Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").Resize(5)
'c. To copy 5 rows up from row 85 (including row 85) Y=5
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").Offset(-4, 0).Resize(5)
'd. To copy the range bounded by any combination of blank rows and blank columns in which "B85:S85" is included
'This will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards
'Also will include also any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").CurrentRegion
' As mentioned before we won't use the clipboard
'instead we replace the values with the values of the target range created earlier
'however we need to extend the range to the same size of the source range
.Range("C" & lastRow + 1).Resize(rSrc.Rows.Count, rSrc.Columns.Count).Value = rSrc.Value2
End With
End Sub
Hope this is clear enough and helps you to make progress with you coding, nevertheless let me know of any questions you might have.
I'm not quite sure what you're looking for - but here' how to loop:
Sub test()
For i = 25 to 30
Range(Cells(i,1),Cells(i,19)).Copy
Range(Cells(i,20),Cells(i,39)).PasteSpecial xlPasteValues
Next i
End Sub
That copies A25:S25 and pastes to T25:AM25...Then A26:S26, pastes T26:AM26, etc. until row 31.
Well now that the requirements are disclosed, we have the opportunity to apply another method. Bear in mind that the fact that the source range contains multiple areas may give us the idea of series of repetitive "copy paste values" which makes the undesirable use of the clipboard, or a repetitive Range Values.
This time instead of setting the source range as an object (which still can be done) we'll use an Array variable to grab the values of the multi-areas range
to later enter them in the target range as a unified and continuous range in one step.
This procedure sets an array with the values of the source range areas and then sets the values of the array to the target range using the Range.Value property.
Sub Range_MultiAreas_CopyValue()
Const kRowIni As Long = 25
Dim Wbk As Workbook
Dim aRngSrc() As Variant
Dim lRowLst As Long, l As Long, b As Byte
Rem Declare Objects
Set Wbk = ThisWorkbook
Rem Set Array with rows to copy as value
With Wbk.Sheets("Tabelle2")
l = kRowIni
For b = 1 To 30
If .Range("V" & l).Value2 = 0 Then
Rem Resize Array
On Error Resume Next
ReDim Preserve aRngSrc(1 + UBound(aRngSrc))
If Err.Number <> 0 Then ReDim Preserve aRngSrc(1)
On Error GoTo 0
Rem Set Row Values In Array
aRngSrc(UBound(aRngSrc)) = .Cells(l, 2).Resize(, 16).Value2
Rem Increase Row Pointer
l = l + 2
End If: Next: End With
Rem Reset Arrays Structure
With WorksheetFunction
aRngSrc = .Transpose(.Transpose(aRngSrc))
End With
Rem Let Array Values in Target Range
With Wbk.Sheets("Tab1")
lRowLst = .Cells(.Rows.Count, 1).End(xlUp).Row
lRowLst = IIf(.Cells(1, 1) = Empty, 1, lRowLst + 1)
.Cells(lRowLst, 1).Resize(UBound(aRngSrc, 1), UBound(aRngSrc, 2)).Value = aRngSrc
End With
End Sub
Once again let me know of any question you might have about the resources used.
As it is not possible to Copy more than one row at once when gaps are between as siddharth rout said we tried to bypass the problem with looping through every signle row which should be copiedand added an if query.
This code is working and i am using "him" now
j = 0
For i = 1 To 30
With Sheets("Arbeiter-Tage")
If Application.WorksheetFunction.CountA(.Columns(1)) <> 0 Then
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Else
lastRow = 1
End If
Sheets("Vorlage").Activate
If ActiveSheet.Range("V" & 25 + j).Value = 0 Then
ActiveSheet.Range("B" & 25 + j & ":" & "Q" & 25 + j).Copy
.Range("A" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End With
j = j + 2
I’ve been working on this VBA code for a while and since I’m a complete noob I feel like I haven’t gotten anywhere. I’ve been researching a ton, but can’t seem to combine answers to help with my scenario.
Essentially what I’m trying to do is grab data, line by line, from one worksheet and extrapolate it to another worksheet. I believe this will involve loops and I’m so new with VBA I don’t know how to do it.
Here’s the logic I’m attempting:
For each row on worksheet 1, I would like to perform 3 different copy and paste activities to worksheet 2 and then it will loop down to the next row on sheet1 and do the 3 activities and so on. This will continue downwards until column A is blank in sheet1. Sheet1 data starts at A3 and sheets2 paste area starts at A2.
The first activity is to copy cells F3,D3,A3, and H3 (in that order so F3 will be A2, D3 will be B2 etc) from sheet 1 to sheet 2 to A2,B2,C2, etc. A destination functions can’t be used because I need just the values and no other formats—one of the many issues I’ve ran in to.
The next activity is to copy cells F3,D3,A3 and I3 from sheet 1 to sheet2 pasted below the previous copy and paste—again no formats just values. Also to note, some of these may be blank (except A column) but I still need that row there with at least column A data—this goes to say with all these activities.
The third activity is to copy and paste sheet1’s F3,D3, and A3 a certain number of times referencing K3’s number—and each copy and paste will be in the next available blank cell. So if the number in K3 it will look like it created 3 rows in sheet2—totaling 5 rows on sheet2 since activity1 and 2 each create their own row.
After these three activities are completed for row 3 on sheet 1, it will then move to row 4 and do the previous three activities and paste to sheet2. And again it will be pasting no formats and in the next blank row on sheet 2. Also again, this loop will stop once the cell in Column A is blank.
Below is my incomplete code. I don’t even think it will help one bit and it would probably be better not to even look at it. I’ve just started to get frustrated since I can’t even do a simple copy and paste, yet alone loops within loops. I also haven’t even started on my third activity. I greatly appreciate it!
Sub copyTest3()
Dim proj As Range, release As Range, pm As Range, lead As Range, coord As Range
Dim leadCopy As Range, coordCopy As Range
Dim i As Range
Set proj = Range("A3", Range("A3").End(xlDown))
Set release = Range("D3", Range("D3").End(xlDown))
Set pm = Range("F3", Range("F3").End(xlDown))
Set lead = Range("H3", Range("H3").End(xlDown))
Set coord = Range("I3", Range("I3").End(xlDown))
Set leadCopy = Union(pm, release, proj, lead)
Set coordCopy = Union(pm, release, proj, coord)
For i = 1 To Range(ActiveSheet.Range("A3"), ActiveSheet.Range("A3").End(xlDown))
leadCopy.Copy
Sheets("Sheet2").Activate
Range("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Sheet1").Activate
coordCopy.Copy
Sheets("Sheet2").Activate
Range("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
Next i
End Sub
There are many ways to do this, and some are more efficient than others. My solution may not be the most efficient, but hopefully it will be easy for you to understand so that you can learn.
It's very difficult to understand what you're attempting to do in activity three, so I wasn't able to provide a solution to that step. Use my code as a template for step three and if you run into issues, feel free to leave a comment.
Notice that I don't use .Activate, .Select, or .Copy in this code. .Activate and .Select are huge efficiency killers, and they make it easier for your code to "break," so avoid using them when possible. .Copy isn't necessary when working with values or formulas and will also slow your code down.
Untested
Sub testLoopPaste()
Dim i As Long
Dim ii As Long
Dim i3 as Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Sheet1")
Set sht2 = wb.Sheets("Sheet2")
'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
ii = 2
'This is the beginning of the loop
For i = 3 To LastRow
'First activity
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
sht2.Range("D" & ii) = sht1.Range("H" & i).Value
ii = ii + 1
'Second activity
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
sht2.Range("D" & ii) = sht1.Range("I" & i).Value
ii = ii + 1
'Third activity
For i3 = 1 To sht1.Range("K" & I)
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
ii = ii + 1
Next i3
Next i
End Sub
The way I usually approach copying data between sheets in Excel is to create source range and destination range objects, each range referring to just one row. When I want to move on to the next row, I use Offset to return a range offset to the next row.
Since the ranges only refer to one row, you can index them with an integer to get the cells in the row. E.g. if cursor refers to columns A through D in row 3, cursor(3) will give you the cell C3.
Dim src_cursor As Range
Dim dest_cursor As Range
Set src_cursor = ActiveSheet.Range("A3:I3")
Set dest_cursor = Sheets("Sheet2").Range("A2:D2")
'' Loop until column A is empty in source data
Do Until IsEmpty(src_cursor(1))
dest_cursor(1) = src_cursor(6) '' copy F -> A
dest_cursor(2) = src_cursor(4) '' copy D -> B
'' and so on
'' move cursors to next row
Set src_cursor = src_cursor.Offset(1, 0)
Set dest_cursor = dest_cursor.Offset(1, 0)
Loop
Also, this might be getting a little off topic, but it's a better practice to use an Enum to name the column numbers instead of hardcoding them like I did here.