New to this forum so sorry if this is off. I'm trying to do a simple copying of cell values from one worksheet in a book to another worksheet, but need to use relative cell references as the number of rows that will be copy/pasted changes depending on the data inputted.
The (very simple) code so far is:
Sub SuitorList()
'Defining Variables
Dim Row As Integer
Row = Sheets("References").Cells(6, 2).Value
'Copying Statistics
Sheets("Charts").Range(Cells(1, 1), Cells(Row, 1)).Value = _
Sheets("Data").Range(Cells(1, 1), Cells(Row, 1)).Value
End Sub
This code works fine when I use absolute cell references (i.e. "B1:B7") but when I use a relative reference I receive error code 1004: Application-defined or object-defined error.
Any thoughts?
Alternative Solution:
If you are not a fan of Loops, use Worksheet.Cells Property
Sub SuitorList()
'Defining Variables
Dim Row As Integer
Set wd = ThisWorkbook.Worksheets("Data")
Set wc = ThisWorkbook.Worksheets("Charts")
Row = Sheets("References").Cells(6, 2).Value
'Copying Statistics
Range(wd.Cells(1, 1), wd.Cells(Row, 1)).Copy Destination:=Range(wc.Cells(1, 1), wc.Cells(Row, 1))
End Sub
If you are copying data from one sheet to another and the amount of data to be copied/pasted is always changing then I would do something like this. Which is filtering the data from your selection sheet then copying it and pasting it to your destination sheet by finding the first blank cell. You may have to mess with this a bit, but it is a good start.
'Defining Variables
Dim Row As Integer
Row = Sheets("References").Cells(6, 2).Value
'switches the sheet
Sheets("Charts").Select
'filters a table based on the value of the Row variable
ActiveSheet.ListObjects("Table1").range.AutoFilter Field:=1, Criteria1:= _
range("Row"), Operator:=xlAnd
'moves to the first cell in the filtered range
range("A1").Select
'selects all values in the range and copies to clipboard
range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
'switches the sheet back to data sheet
Sheets("Data").Select
'finds the first blank cell in the declared range you want to paste into
ActiveSheet.range("A:A").Find("").Select
'pastes the selection
ActiveSheet.Paste
Thanks for the help. I was able to find a work around using the following code:
Sub SuitorList()
'Defining Variables
Dim Row As Integer
Row = Sheets("References").Cells(6, 2).Value
'Copying Statistics
For i = 1 To Row
Sheets("Charts").Range("A" & i).Value = Sheets("Data").Range("A" & i).Value
Next
End Sub
Related
I am attempting to move ranges (of varying lengths) between two workbooks.
Windows("Comp1.xlsx").Activate 'Open sheet to pull data from
Range("E2").Select 'Starting point is the same every time
Range(Selection, Selection.End(xlDown)).Select 'Select all data below
Application.CutCopyMode = False
Selection.Copy 'Copy range
Windows("Comps Proto.xlsm").Activate 'Sheet to be pasted into
Range("K12").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False 'Paste data into new sheet
In order to repeat this function for the next workbook, I need to move off the pasted selection. I have tried everything, including offset, and Application.CutCopyMode = False. Doesn't work.
See below picture: The first paste cycle ends with that range selected. I want to move to the cell labeled and circled Start. This is where the next range will be pasted in the same fashion as above, rinse and repeat
The main issue I was trying to resolve was getting the cursor to click off a pasted range, so that I could continue. I found the code below to be helpful. This is the original post on another forum: https://superuser.com/questions/342772/how-do-i-move-the-selection-down-one-row-in-excel-2007/342835
Dim ColNumber As Integer
ColNumber = Selection.Column
Range("K" & CStr(ColNumber)).Select 'Click off the pasted values
ActiveCell.End(xlDown).Select 'Equivalent of ctrl+down
ActiveCell.End(xlDown).Select 'Moves down through the range in picture
ActiveCell.Offset(2, 0).Select 'Moves selection to the "Start" point in picture above
Judging by your range location, it has free cells across all borders. This allows to use handy CurrentRegion property. In my code I assume you have 5 such blocks to copy. Feel free to change the place to copy to.
Sub MoveCells()
Dim x%, rng As Range
Set rng = [E5].CurrentRegion
'// Copy 5 blocks of cells
Do
'// Change target cell to the one you need
rng.Copy Sheets(2).Cells(1, x + 1)
'// Here we locate last cell in block of cells, offset two cells down
'// and select CurrentRegion again
Set rng = rng(rng.Cells.Count).Offset(2).CurrentRegion
x = x + 1
Loop While x <= 5
End Sub
I have a macro that exactly copies one sheet's data into another.
Sub QuickViewRegMgmt()
("Reg Management").Select
Cells.Select
Selection.Copy
Sheets("Quick View Reg Mgmt").Select
Cells.Select
ActiveSheet.Paste
End Sub
I would like for this macro to also go to the last non-blank cell in Column C (or first blank, I really don't care either way). I tried simple end/offset code, e.g.
Range("A1").End(xldown).Offset(1,0).Select
My problem, however, is that the direct copy macro also copies the underlying formulas, which for Column C is an IF formula. Therefore, no cell in the column is actually empty, but rather they all have an IF formula resulting in a true/false value (respectively, a "" or VLOOKUP).
=IF(VLOOKUP('Reg Management'!$Y260,'Reg Guidance'!$A:$V,3,FALSE)=0,"",VLOOKUP('Reg Management'!$Y260,'Reg Guidance'!$A:$V,3,FALSE))
That means the end/offset code goes to the last cell in the column with the formula (C1000) instead of going to the first cell that has a value of "" (which is currently C260).
What code can I add to this macro to select the first cell that contains an IF formula resulting in a value of "" ---- which has the appearance of being blank?
After trying to be fancy with SpecialCells(), or using Find() or something I couldn't get it ...so here's a rather "dirty" way to do it:
Sub test()
Dim lastRow As Long, lastFormulaRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Dim i As Long
For i = lastRow To 1 Step -1
If Cells(i, 1).Formula <> "" And Cells(i, 1).Value = "" Then
lastFormulaRow = i
Exit For
End If
Next i
End Sub
Edit2: Here's one using .SpecialCells(). Granted I think we can whittle this down more, I like it better:
Sub lastRow()
Dim tempLastRow As Long
tempLastRow = Range("C" & Rows.Count).End(xlUp).Row
Dim lastRow As Range
Set lastRow = Columns(3).SpecialCells(xlCellTypeFormulas).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole, searchdirection:=xlPrevious, after:=Range("C" & tempLastRow))
Debug.Print lastRow.Row
End Sub
It returns 10 as the row.
Edit: Be sure to add the sheet references before Range() and Cells() to get the last row. Otherwise, it's going to look at your active sheet to get the info.
I'm struggling with the following problem:
I want to copy a range of fields (E18:BE18) from sheet1 to Sheet 2.
The issue is, however, that the row it should be copied in is dependent on the value in sheet1.C15. This value should be found in the B-column in Sheet2.
For instance if Sheet2.B10 has the same value as Sheet1.C15, then the range Sheet1.(E18:BE18) should be copied to Sheet2.(E10:BE10).
Thanks!
You can use this code
Dim objSheetA As Worksheet
Dim objSheetB As Worksheet
Set objSheetA = Worksheets("SheetA")
Set objSheetB = Worksheets("SheetB")
If objSheetB.Cells(10, 2).Value = objSheetA.Cells(15, 3).Value Then
objSheetA.Range(Cells(18, 5), Cells(18, 57)).Select
Selection.Copy
objSheetB.Select
objSheetB.Cells(10, 5).Select
ActiveSheet.Paste
End If
I have a piece of "crude" code which copies some data from one sheet to Another, and the sheet-name from which the data is copied can be found in a cell. However, the number of sheets are now growing, and I have created a dynamic named range for the sheetnames, and would like to perform the following code for all the sheets in the dynamic range. My code looks like this:
Calculate
' get the worksheet name from cell AA3
Worksheets(Range("AA3").Value).Activate
' Copy the data
Range("A1:A1500").Select
Selection.Copy
' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Select
Dim NextRow As Range
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Now, I would like to have something like a loop with reference to the dynamic range but I am unable to get it to work as VBA really is not my cup of tea...So, instead of referencing AA3, AA4 etc I would like to referebnce the named range which contains the data of AA3, AA4....AAx. The named range might also contain blank cells, as it is the result of an Array formula in AA3....AA150.
Thank you!
/Fredrik
The following code should work for you. I assumed that the named range (i called it copysheets) is in the active workbook (scope workbook).
Sub copySheets()
Dim sheetName As Range
Dim copyRange As Range
Dim destinationRange As Range
For Each sheetName In Range("copysheets")
If sheetName.Value <> "" And sheetName.Value <> 0 Then
Set copyRange = Sheets(sheetName.Value).Range("A1:A1500")
Set destinationRange = Sheets("Artiklar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
copyRange.Copy
destinationRange.PasteSpecial xlPasteValues
End If
Next
End Sub
Dim myNamedRng as Range, cell as Range
'...
Set myNamedRng = Worksheets("MySheet").Range("myRange") '<-- set a variable referencing your named Range
With Sheets("Artiklar")
For Each cell In myNamedRng
If cell.Value <>"" Then .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1500).Value = Worksheets(cell.Value).Range("A1:A1500").Value
Next cell
End With
The following example loops through each cell in a named range by
using a For Each...Next loop. If the value of any cell in the range
exceeds the value of Limit, the cell color is changed to yellow.
vba
Sub ApplyColor()
Const Limit As Integer = 25
For Each c In Range("MyRange")
If c.Value > Limit Then
c.Interior.ColorIndex = 27
End If
Next c
End Sub
Source
So you might start off with something like this:
Calculate
Dim NextRow As Range
' get a range object from the named range
For Each c In Range("[File.xls]Sheet1!NamedRange")
' Copy the data
Worksheets(c.Value).Range("A1:A1500").Copy
' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Activate
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial xlPasteValues
Next c
You'll notice that I was a bit more explicit with how the named range is being referred to - the requirement here might vary depending on how you declared the range to begin with (what its scope is), but the way I did it will most likely work for you. See the linked article for more information about scope of named ranges.
-= Problem Solved =-
Thank you all for your contribution to my question! All the answers that I received has helped me refine my code, which is now functioning properly!
Regards,
Fredrik
I have 3 Sheets: Work, Bill, and Cust. Cust column A contains my unique customers, which I then paste onto cell A3 on the Work sheet where it runs its calculations and then paste it on to the Bill sheet. I then take the next value on the Cust sheet and i paste it back to Work, run the calculation and paste it below the previous set on the Bill sheet. I have 2 questions.
Why isn't my loop working? I'm trying to keep going until I run out of customers on the cust sheet?
Why is it that I can use the custom range BillPlace in the first part of my code, yet I actually have to refer to the cells in the later parts?
Thanks in advance
Sub test1()
Dim WorkPlace As Range, BillPlace As Range, WorkProd As Range
Set WorkPlace = Sheets("Work").Cells(3, 1)
Set BillPlace = Sheets("Bill").Cells(3, 1)
Set WorkProd = WorkPlace.CurrentRegion
WorkPlace.CurrentRegion.Copy
BillPlace.PasteSpecial xlPasteAll
Sheets("Cust").Select
Cells(1, 1).Copy
WorkPlace.PasteSpecial xlPasteAll
WorkProd.Copy
Sheets("Bill").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Sheets("Cust").Select
Cells(2, 1).Select
Selection.Offset(1, 0).Select
Do
ActiveCell.Offset(1, 0).Copy
WorkPlace.PasteSpecial xlPasteAll
WorkProd.Copy
Sheets("Bill").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Loop Until IsEmpty(ActiveCell.Offset(1, 0))
End Sub
#Portland Runner has a point about using a For Each / Next loop. By doing that you can probably eliminate the counters and a bunch of selecting from your working code above, removing a bunch of complexity from your process.
The principle of a For/Next loop is easy enough: define TheLargerRange containing the cells you will loop through. Define a SingleCell range to contain the current cell you are working with. Then you can start the loop saying something like:
For Each SingleCell in TheLargerRange
'~~> your loop actions go here
Next SingleCell
Also, you can do a lot without selecting specific locations in your workbook. Instead copy, paste, or assign values by just referencing the location. If you want, you can set variables to make this easier in longer code.
The following example just moves a column of customer data from one sheet to another, as an example of how to use the For Each / Next loop structure and how to avoid selecting everything you work with. There is only one selection in this code, and that is only because the compiler chokes if you use End(xldown) to attempt setting a range on an unselected tab. Otherwise there could be no selections.
Sub UsingForNextAndAvoidingSelections()
'~~> Set variables for referencing the "Cust" tab
Dim CustomerList As Range
Dim Customer As Range
Dim CustomerTab As Worksheet
Set CustomerTab = Sheets("Cust")
CustomerTab.Select
Set CustomerList = CustomerTab.Range("A1", Range("A1").End(xlDown))
'~~> Set variables for referencing the "Bill" tab
Dim BillTab As Worksheet
Dim BillRow As Range
Set BillTab = Sheets("Bill")
Set BillRow = BillTab.Range("A1")
'~~> Loop through the customer list, copying each value to the new BillRow location
For Each Customer In CustomerList
Customer.Copy
BillRow.PasteSpecial xlPasteAll
Set BillRow = BillRow.Offset(1, 0)
Next Customer
End Sub
12/27/2013: I just realized why the code Set CustomerList = CustomerTab.Range("A1", Range("A1").End(xlDown)) was throwing an error when CustomerTab was not selected: I forgot to fully qualify the second range statement in that line: Range("A1").End(xlDown).
I believe that if you qualify that line of code like this Set CustomerList = CustomerTab.Range("A1", CustomerTab.Range("A1").End(xlDown)) you can eliminate the CustomerTab.Select that precedes it and conduct the entire process without a single Select.
WorkProd.Copy
Sheets("Bill").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Loop Until IsEmpty(ActiveCell.Offset(1, 0))
You are going to the end of a column and pasting one row further down. You then check if the cell one row further down is empty, but it won't be because you've just pasted into it. This is why it repeats endlessly.
I assume you should be looking for an empty cell somewhere other than one row below the current cursor position.
HA! i fixed it. This isn't the most orthodox approach but it worked. Oh pardon me but i did it in production so the name of the sheets and cell positions changed slightly. CountC is a helper cell that counts the number of customers. Thanks everyone for your help.
Sub Pull_Billing()
Dim WorkPlace As Range, BillPlace As Range, WorkProd As Range, PlaceHolder As Range, CountC As Integer, n As Integer
Set WorkPlace = Sheets("Work").Cells(3, 1)
Set BillPlace = Sheets("ABS_Billing_Sheet").Cells(3, 1)
Set WorkProd = WorkPlace.CurrentRegion
CountC = Sheets("CTA_Info").Cells(1, 5).Value
Sheets("CTA_info").Cells(2, 2).Copy
WorkPlace.PasteSpecial xlPasteAll
WorkPlace.CurrentRegion.Copy
BillPlace.PasteSpecial xlPasteAll
Sheets("CTA_Info").Select
Cells(3, 2).Copy
WorkPlace.PasteSpecial xlPasteAll
WorkProd.Copy
Sheets("ABS_Billing_Sheet").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Sheets("CTA_Info").Select
Cells(4, 2).Select
n = ActiveCell.Row
Do
Cells(n, 2).Select
Selection.Copy
WorkPlace.PasteSpecial xlPasteAll
WorkProd.Copy
Sheets("ABS_Billing_Sheet").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Sheets("CTA_Info").Select
Cells(n + 1, 2).Select
n = ActiveCell.Row
Loop Until n > CountC + 2
Sheets("CTA_info").Cells(2, 2).Copy
WorkPlace.PasteSpecial xlPasteAll
Sheets("ABS_Billing_Sheet").Select
End Sub