I have data in Excel. I want to copy the header and some data from the middle of sheet to Powerpoint. I know that you can't copy a selection of non-adjacent cells in Excel, but I was under the impression it would work with VBA.
My try:
With Workbooks(1).Sheets(1)
Set rng = Union(.Range("B2:K3"), .Range("B45:K85"))
End With
I can select "rng", but I can't paste it anywhere because I get the error message that you can't paste non-adjacent cells.
I've also tried this, but it resulted in the whole table (B2:K85) getting copied:
With ThisWorkbook.Sheets("Sheet1")
Set rng1 = .Range("B2:K3")
Set rng2 = .Range("B45:K85")
Set NewRng = .Range(rng1.Address & ":" & rng2.Address)
End With
I've googled this question and tried various things, but either I misunderstood what is possible with VBA or I'm making a mistake (over and over again).
So do I have to alter my code or do I have to work around it? My alternative solution would be to copy-paste each of the two ranges, put them underneath each other and then copy the whole, now contiguous range.
You can use the Areas property of the Range object to get the unionized ranges. Code like the below will loop through each of the sub-ranges, copy them, and paste them elsewhere. Try and adapt to your needs, and write back if you need some help.
Sub Test()
Dim rng As Range
Dim r As Range
Dim destination As Range
Set rng = Union(Range("A1:B3"), Range("D1:E2"))
Set destination = Range("H1")
For Each r In rng.Areas
r.Copy destination
Set destination = destination.Offset(, 3)
Next r
End Sub
Related
The following VBA code (Excel 2007) is failing with Error 1004, "Autofill Method of Range Class Failed.". Can anyone tell me how to fix it?
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B:U")
Set src = wks.Range("A6")
src.AutoFill Destination:=out
(note: I have Googled, etc. for this. It comes up fairly often, but all of the responses that I saw had to do with malformed range addresses, which AFAIK is not my problem.
At someone's suggestion I tried replacing the autofill line with the following:
src.Copy out
This had the effect of throwing my Excel session into an apparent infinite loop consuming 100% CPU and then just hanging forever.
OK, apparently the source has to be part of the destination range for autofill. So my code now looks like this:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B1")
Set src = wks.Range("A6")
src.Copy out
Set out = wks.Range("B:U")
Set src = wks.Range("B1")
src.AutoFill Destination:=out, Type:=xlFillCopy
Same error on the last line.
From MSDN:
The destination must include the
source range.
B:U does not contain A6 and thus there is an error. I believe that you probably want out to be set to A6:U6.
Specifiying just the column name means that you want to fill every row in that column which is unlikely to be the desired behvaiour
Update
Further to the OP's comment below and update to the original answer, this might do the trick:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B1")
Set src = wks.Range("A6")
src.Copy out
Set out = wks.Range("B1:U1")
Set src = wks.Range("B1")
src.AutoFill Destination:=out, Type:=xlFillCopy
Set out = wks.Range("B:U")
Set src = wks.Range("B1:U1")
src.AutoFill Destination:=out, Type:=xlFillCopy
AutoFill is constrained to a single direction (i.e. horizontal or vertical) at once. To fill a two-dimensional area from a single cell you first have to auto-fill a line along one edge of that area and then stretch that line across the area
For the specific case of copying the formatting and clearing the contents (by virtue of the source cell being empty), this is better:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Sheet1
Set out = wks.Range("B:U")
Set src = wks.Range("A6")
src.Copy out
To make AutoFill work, you need to make the range of AutoFill more than the source range. If the AutoFill range is same as of Source range then there is nothing to AutoFill in that range and hence you would get an error
1004: AutoFill method of Range class failed.
So make AutoFill range more than the source range and error will gone.
If you want to autofill you just do something like...
Private Sub Autofill()
'Select the cell which has the value you want to autofill
Range("Q2").Select
'Do an autofill down to the amount of values returned by the update
Selection.AutoFill Destination:=Range("Q2:Q10")
End Sub
This would autofill down to the specified range.
Does ths help?
Not sure if this helps anyone, but I needed something similar. Selecting the cells as destination works;
dim rowcount as integer
Sheets("IssueTemplate").Select ' Whatever your sheet is
rowcount = 0
rowcount = Application.CountA(Range("A:A"))'get end range
Cells(4, 3).Select 'select the start cell
'autofill to rowcount
Selection.AutoFill Destination:=Range("C4:C" & rowcount), Type:=xlFillDefault
in my example I had to auto-generate a list of folder names from OA100 to OA###?, and this worked fine.
Let me preface this with that I am by no means a developer/code writer, so I am running on the barest of bones when it comes to understanding everything.
In an excel sheet I am creating for work, I am using code that checks cells for their color based on conditional formatting, then changes the color of the cells in another sheet to match them. I went with a macro vs CF due to the number of columns/rows that are being controlled, and to let each person using the sheet customize the color to what they prefer without having to change hundreds of lines to do it.
The code I am using is :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xWRg, xDERg, xlWRg, xlDERg As Range
Dim xfnum As Long
'On Error Resume Next
Set xDERg = Sheets("Data Entry").Range("D9:D200")
Set xWRg = Sheets("Worksheet").Range("E6:E200")
For xfnum = 1 To xWRg.Count
Set xlWRg = xWRg.Cells.Item(xfnum)
Set xlDERg = xDERg.Cells.Item(xfnum)
xlDERg.Interior.Color = xlWRg.DisplayFormat.Interior.Color
Next xfnum
End Sub
I have it working for that specific range, but I also need it to check G9:G200 on Data Entry and K6:K200 on the worksheet, a long with a couple other columns. There are 7 total ranges that need to be controlled by this.
Here is your code rewritten to clean it up. Note: If your destination range is smaller then the source range, then cells below the destination range may be colored.
Dim xWRg As Range: Set xWRg = Sheets("Worksheet").Range("E6:E200") 'Set your source range
Dim xDERg As Range: Set xDERg = Sheets("Data Entry").Range("D9:D203") 'Set your destination range, usaually same number of cells
For xfnum = 1 To xWRg.Count 'loop through the number of items in source range
'copy the conditional formating color to the destination range
xDERg.Item(xfnum).Interior.Color = xWRg.Item(xfnum).DisplayFormat.Interior.Color
Next xfnum 'loop
If you could clarify what sheet/range will activate the Worksheet_SelectionChange event, and the additional five ranges you need to add, I can provide better guidance, it depends on the layout of the ranges you want to work with.
So I am trying to use the autofill method in vba right now over a range that is set to a variable. I know that the range of cells you are autofilling from must be included in the destination. So, I do just that. However, and much to my surprise, all the cells in the range are being set to nothing.
Here is the code:
Dim table2Range As Range
Dim table2Range2 As Range
Dim table2Range3 As Range
Dim tableholder As Range
Set table2Range2 = Range("Y54").End(xlToRight).Offset(0, 1)
Set table2Range3 = Range("Y77").End(xlToRight).Offset(0, 1)
Set table2Range = Range(table2Range2, table2Range3)
Set tableholder = Range("y54", table2Range3)
tableholder.Select
table2Range.AutoFill Destination:=Selection 'This is setting all my cells to nothing for some reason
Here is the before & after screenshots:Before, After
Any help is hugely appreciated!
Your AutoFill line of code should be:
SourceRange.AutoFill Destination:FillRange
It seems like your "table2Range " is the source, which overlap with your Fill Range. I.e:
.End(xlToRight).Offset(0, 1) will set range from Y54 to the rightmost cell of the same row.
You can edit the source range with hardcode first (i.e. Range("Y54:Z77") and see if that works for you, then work from there
For example (try on a new workbook):
Sub example()
Set SourceRange = Worksheets("Sheet1").Range("A1:B1")
Set fillRange = Worksheets("Sheet1").Range("A1:G1")
SourceRange.AutoFill Destination:=fillRange
End Sub
Enter "1" in cell(A1) and "2" in Cell(B1) and run the code.
How can i modify the code below to select data from any worksheets and copy they to another worksheet for example select and copy data from Worksheets("uno") and paste they to Worksheets("duo"). Because the code below selects data only on activesheet
Set tbl = ActiveCell.CurrentRegion
tbl.Resize(tbl.Rows.Count, tbl.Columns.Count).Select
I have a code to copy data from any sheet to another for example
Worksheets("uno").Range("A5:T5,A7:T56,W5,Y5,W7:W56,Y7:Y56").Copy _
Worksheets("duo").Range("B4")
But i want to copy a range with data and ignore blank cells because the range A5:T5 it doesn't have always all cells with data concretely the last cells of this range, two or three of those, and also the same on range A7:T56.
My problem is how to select a range with data and ignore the blank cells inside the range A7:T56 concretely the last rows and the last columns which haves blank cells
Well, for the first part, where "the code selects data only on the activesheet", you just need to activate the correct sheet (for example: "Worksheets("uno").Activate") before executing "Set tbl = ActiveCell.CurrentRegion".
I am not really sure if I understand you correctly, but these are my thoughts:
If you don't want to activate worksheet "uno" you need to create a reference to that worksheet to have a direct access to it:
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set wkb = Excel.Application.Workbooks("<name of your workbook>")
Set wks = wkb.Worksheets("uno")
If you now use the following code:
wks.Range("<your range>").Copy
you have just copied your selected cells, now you can paste it wherever you want.
As for the part with avoiding empty cells:
Generally speaking, you need to create a method of checking whether relevant cells are empty or not before you add them to your range.
Personally, I would avoid trying to copy the whole range as such. Instead I would:
1) loop through all relevant cells in your range one by one
2) for each cell check if it's empty
3) if empty, go to next cell
4) if not empty, copy that cell and paste to the target worksheet
5) jump to next relevant cell
6) when you reach the cell which is just after your last cell, quit looping
I would use the above defined wks object.
Note that a Range object can be treated as a collection of strings, so you can iterate using For... Next loop (For Each loop does not guarantee the index order).
Something like this should do:
Dim rng As Range
Set rng = wks.Range("<your range>")
Dim numOfItems As Integer, itm, i As Integer
numOfItems = rng.Count
For i = 1 To numOfItems
itm = rng.item(i)
If itm <> "" Then
'set value of the corresponding cell in your target worksheet to itm
'<relevant cell>.Value = itm
Else
'do nothing
End If
Next i
I hope it's at least a little bit helpful.
I am new to the world of VB but I would like to copy data from one tabs on a spreadsheet called Ilog and past this into another tab on the same spredshhet on a tab called Journal.
When the data is pasted to the new tab I'd normally filter is so Blanks are ommited so I would like to be able to get the VB code to do this automatically.
Any help would be greatly appreciated
I am not certain what you are asking, but the following code will copy data from a range on sheet llog and paste in journal. Then loop through and delete cells that are blank.
Sub test()
Dim rng As Range
Set rng = Worksheets("llog").Range("A1:A8")
rng.Copy
Set rng = Worksheets("journal").Range("A1:A8")
rng.PasteSpecial
For Each c In Range("A1:A8")
If c.Value = "" Then
c.Delete
End If
Next c
Set rng = Nothing
End Sub
Depending on the complexity of the range being copied, you could also go with:
Sub test()
Dim rng As Range
Set rng = Worksheets("llog").Range("A1:A8")
rng.Copy
Set rng = Worksheets("journal").Range("A1:A8")
rng.PasteSpecial
rng.SpecialCells(xlCellTypeBlanks).Delete
End Sub
which avoids any looping. If you have a relatively complex range, you may want to look in to using the autofilter and then coping over just the visible rows.