I am trying to copy data from one Excel workbook to another.
We had a change in the template of an import file, and it has thus ruined the old import files. So there are some files that still need to be imported, but they are under the old template.
My issue stems from when I try to copy the data (paste special, values, anything tried) it gives me an error sometimes: "The Cell or chart that you are trying to change is protected and therefore read-only".
However, that isn't exactly the case. I've determined that it gives that error when I paste a blank cell onto a new field that has a drop-down with Yes or No. Yet, if I manually go to that cell and give it something blank (hit backspace + enter), it has no problems.
I've tried coding so it copy/paste's each line at a time from workbook to workbook, but my problem still remains for these cells that require a drop-down answer. I'm thinking that these cells need to be coded to actually be "typed" instead of pasted. It can't be a part of pasting the actual range.
Does anyone have an idea of how best to resolve this? Below is my current code, it is copying based on the range(s). It's very sloppy as the only way I can think is to keep switching from workbook to workbook. Any help is greatly appreciated.
Also, I'm not 100% on how to calculate the LastRow? So I just have it entered manually.
Sub MoveText()
For Row = 5 To 962
Workbooks("Data.xls").Activate
ActiveSheet.Range(Cells(Row, 1), Cells(Row, 3)).Select
Selection.Copy
Workbooks("blankTemplate.xls").Activate
ActiveSheet.Range(Cells((Row + 1), 1), Cells((Row + 1), 3)).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("data.xls").Activate
ActiveSheet.Range(Cells(Row, 5), Cells(Row, 29)).Select 'this will select the contents of the active row
Workbooks("blankTemplate.xls").Activate
ActiveSheet.Range(Cells((Row + 1), 5), Cells((Row + 1), 29)).Select
Selection.PasteSpecial Paste:=xlPasteValues
Next
Sub MoveText()
Dim shtData As Worksheet, shtTempl As Worksheet
Dim Row As Long
Set shtData = Workbooks("Data.xls").Sheets("Data") 'or e.g. .Sheets(1)
Set shtTempl = Workbooks("blankTemplate.xls").Sheets("Data")
For Row = 5 To 962
shtTempl.Cells(Row + 1, 1).Resize(1, 3).Value = _
shtData.Cells(Row, 1).Resize(1, 3).Value
shtTempl.Cells(Row + 1, 5).Resize(1, 25).Value = _
shtData.Cells(Row, 5).Resize(1, 25).Value
Next Row
End Sub
Related
So I created a copy and paste function. I had help previously with an error I encountered. However, I am now wanting to make the values copy and pasted to be updated when the original date is changed. So, my original thought was to paste something like =(ws.Cells(i, j). And have a nested for loop to with the values i staying the same as below and j going in between 6 and 16. But I couldn't get that to work.
If there is a special paste function or something that I am unaware of that would be great. Is there a way to get copy and paste data but also have it still be reliant on the original (updates when the original is changed).
If there is another question with a solution to this problem then I didn't see it and I am sorry.
I have my code below. And any help would be appreciated.
Private Sub CommandButton1_Click()
Dim rng As Range
Dim ws As Worksheet
Set ws = Worksheets("Goals")
a = Worksheets("Goals").Cells(Rows.Count, 7).End(xlUp).Row
For i = 2 To a
If Worksheets("Goals").Cells(i, 20).Value = "Red" Then
ws.Activate
Set rng = ws.Range(ws.Cells(i, 6), ws.Cells(i, 16)) 'columns to be copied
rng.Copy
Worksheets("Scorecard").Activate
b = Worksheets("Scorecard").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Scorecard").Cells(b + 1, 2).Select
ActiveSheet.Paste
Worksheets("Goals").Activate
End If
Next
Application.CutCopyMode = False
Worksheets("Forms").Activate
Worksheets("Forms").Cells(22, 10).Select 'going back to the Forms page
End Sub
Try this
Worksheets("Goals").Range("I6:I16").Copy
Worksheets("Scorecard").Paste Link:=True
I hope you wont mind if the sheets switch in this process..
Thanks
I have some issues while trying to copy/paste data between workbooks. I need to extract data from two different workbooks (A & B) to put it in a third one.
Since A & B have the exact same structure, I use the same code for both of them. However it works for A and I've got an error 1004 for B.
It seems that it happens when you do not specify the parent workbook/worksheet properly but I don't think this is the issue here since the code works for A.
If someone has an insight on this matter, I'm all ears!
Thank you for your help!
CH
Sub Data_Extraction()
Dim wb As Workbook, wba As Workbook, wbb As Workbook
Set wb = ActiveWorkbook
Set wba= Workbooks.Open("D:\xxx\A.xlsx")
Set wbb= Workbooks.Open("D:\xxx\B.xlsx")
Dim wsa As Worksheet, wsb As Worksheet
Set wsa = wb.Worksheets("a")
Set wsb = wb.Worksheets("b")
'I use a named variable here
X = Range("X")
If X=2 Then
''We fill the tab a''
For i = 9 To 400
wba.Activate
If wba.Worksheets("a").Cells(i, 2).Value = 5 Then
wba.Worksheets("a").Range(Cells(i, 1), Cells(i, 8)).Copy
wb.Activate
wsa.Range(Cells(7, 2), Cells(7, 9)).PasteSpecial Paste:=xlPasteValues
wsa.Range("B7").EntireRow.Insert
End If
Next i
''We fill the tab b''
For i = 9 To 400
wbb.Activate
If wbb.Worksheets("b").Cells(i, 2).Value = 5 Then
wbb.Worksheets("b").Range(Cells(i, 1), Cells(i, 8)).Copy
wb.Activate
wsb.Range(Cells(7, 2), Cells(7, 9)).PasteSpecial Paste:=xlPasteValues
wsb.Range("B7").EntireRow.Insert
End If
Next i
End If
End Sub
In lots of cases when you use Excel methods like protect/unprotect copy/paste, you should try to mimick as close as possible the configuration Excel would be in when a user would go through those steps, if you step away from that you are likely to wind up with instability cropping up in generic error codes as 5 and 1004.
In this case I believe you should do
wbb.Worksheets("b").Activate
before you start a copy from worksheet("b").
The real problem here is not that you didn't activate the sheet (though that does work, it's not a good solution)
wbb.Worksheets("b").Range(Cells(i, 1), Cells(i, 8)).Copy
Here the Cells() calls (unlike the Range() call) are not qualified by any worksheet object, so they will default to the ActiveSheet. In a regular module this is equivalent to writing:
wbb.Worksheets("b").Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, 8)).Copy
...and is prone to failure when the active sheet is not what you expect.
This is robust and doesn't require you to activate a specific worksheet:
With wbb.Worksheets("b")
.Range(.Cells(i, 1), .Cells(i, 8)).Copy
End With
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 another question which I hope to resolve with your help.
What do I want to do.
I use Excel to track my work, activities, contacts, et cetera. While doing that I found I was doing a lot of repetitive work in adding rows at the end of a sheet called "Activities".
What I want to do is this:
- Press a button and adding a row.
- Increase the trackingnumber with 1
- Insert default values
The code.
To automate this, I have found (copy, pasted, adjusted it to my needs) the following code:
Sub AddRowActiviteiten_NewAtEnd()
'Add's a new row at the end of the sheet.
Dim wsActiviteiten As Worksheet
Set wsActiviteiten = Sheets("Activiteiten")
DefType = "Daily"
DefStatus = "Open"
DefIssue = "*****"
DefImpact = "*****"
DefPrio = "Laag"
MyDate = Date
wsActiviteiten.Range("A4").Value = "1"
'Copy the "One Row To Rule Them All"
wsActiviteiten.Range("A3:Q3").Copy
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
'Stop the "copy-action"
Application.CutCopyMode = False
'Increase the tracking number with "one"
LastNumber = wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Value
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = LastNumber + 1
'Insert default values
LastRow = wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(-1, 0).Row
Cells(LastRow + 1, 2) = DefType
Cells(LastRow + 1, 3) = DefStatus
Cells(LastRow + 1, 4) = DefIssue
Cells(LastRow + 1, 5) = DefImpact
Cells(LastRow + 1, 6) = DefPrio
Cells(LastRow + 1, 8) = MyDate
'Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
End Sub
The problem.
In this sheet I open new items, but I also close them. I do this by changing their status and hide them from view. And this is the point where it goes wrong. When I close the last item on the list and want to add a new row, the macro adds a new row below the last visible entry. It does not find the last entry I have just hidden. And also, when this happens, adding the default values to the new row does not work. It adds them at the row above the added one.
Somehow this makes perfect sense. I tell the macro to look for the last entry, but what I don't understand is why it looks at the last visible entry and why it does not look in the hidden rows.
To replicate. Copy the code into a sheet (maybe you need to change the name of the sheet) and add a few lines. Put some info in the last row and hide it. Add another few lines and see what happens.
The solution. Is there a way to resolve this? Maybe there is a smarter way of doing things? I looked into things, but mostly I got results using "("A" & Rows.Count).End(xlUp)". A loop could work, but I am afraid that 1) It does not search through hidden rows and 2) it makes the sheet (somewhat) sluggish. I must say I have tried to make a loop, first I want to see if my first solution is salvageable.
Thank you for your input, if there are any questions please let me know.
Simon
EDIT: Working code for anyone interested
Sub AddRowActiviteiten_NewAtEnd()
'Add's a new row at the end of the sheet.
Dim wsActiviteiten As Worksheet
Set wsActiviteiten = Sheets("Activiteiten")
DefType = "Daily"
DefStatus = "Open"
DefIssue = "*****"
DefImpact = "*****"
DefPrio = "Laag"
MyDate = Date
'Copy the One Row To Rule Them All
wsActiviteiten.Range("A3:Q3").Copy
'Offset(y,x)
'De -16 is een getal dat iets doet, maar ik weet niet wat.
wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(1, -16).PasteSpecial (xlPasteAll)
'Stop the "copy-action"
Application.CutCopyMode = False
'Het volgnummer verhogen met 1
'Het laatste getal selecteren (LastNumber) en dan plus 1.
LastNumber = wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(0, -16).Value
wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(1, -16).Value = LastNumber + 1
'Insert default values
LastRow = wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(-1, 0).Row
Cells(LastRow + 1, 2) = DefType
Cells(LastRow + 1, 3) = DefStatus
Cells(LastRow + 1, 4) = DefIssue
Cells(LastRow + 1, 5) = DefImpact
Cells(LastRow + 1, 6) = DefPrio
Cells(LastRow + 1, 8) = MyDate
'Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
End Sub
Update
I see your sheet has an autofilter "hiding" the status rows - which Find wont detect, unlike hidden rows.
Suggest you try this updated code below:
Sub Test()
Dim rng1 As Range
If ActiveSheet.AutoFilterMode Then
MsgBox ActiveSheet.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Row
Else
Set rng1 = Columns("A:A").Find("*", [a1], xlFormulas, , xlByRows, xlPrevious)
If Not rng1 Is Nothing Then MsgBox rng1.Row
End If
End Sub
initial post
If you are hiding rows then you can use Find with the xlFormulas option to find entries in hidden rows (unlike xlValues).
Dim rng1 As Range
Set rng1 = Columns("A:A").Find("*", [a1], xlFormulas, , xlByRows, xlPrevious)
MsgBox rng1.Address
Say we have a status column AB and we currently close an item by placing the word "Closed" in that column and then hiding the row.
Instead:
Unhide all rows
Perform any required inserts and edits
Via a loop, hide all rows marked "Closed"
Use this for getting the last row and it will see the last row, even if it is hidden.
LastRow = wsActiviteiten.UsedRange.Rows.Count
I've just found solution:
If you have at least one column in your range with 'consistent' data (all cells in that column are not empty/blank) you can use formula COUNTA and you can reference you code to value of that COUNTA formula.
For example:
Insert formula '=COUNTA(A1:A100000)' in 'B1' cell.
In B1 you will get how many rows you have they are hidden or not.
In your code change:
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
to
wsActiviteiten.Range("A" & Range("B1").Value).Offset(1, 0).PasteSpecial (xlPasteAll)
Of course, if, for example, cell 'A2' is blank and this is the only blank cell you will need to adjust your formula to '=COUNTA(A1:A100000) +1'.
If you have more blank/empty cells and you don't know the exact number of them (blank cells have been changed dynamically) this method will not work.
As I said previously you need to have at least one column with 'consistent' data (with known number of empty cells in advance if any).
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