Working Environment: Excel 2013
Target: Copy C1:C9 to B11:B19. D1:D9 to B21:B29. E1:E9 to B31:B39.....
After copying all the range to column B, copy A1:A9 to A11:A19(A21:A29....)
My idea is that:
1. select a range by using something like
range.end()
because in some of my sheets, there are only 4 test steps. so I need a syntax which can self inspect the used cells in a column.
do a range copy to column B.
leave 1 row in between considering about the page layout.
My piece of code is:
Worksheets("Master").Columns(3).UsedRange.Copy
Worksheets("Master").Range("B11").PasteSpecial
but seems like the Columns(i).UsedRange.Copy doesn't work. the pastespecial works.
My question is：
How to select the used range in columns? The number of columns are not fixed which means some of the sheets have 40 columns, but some of the other have maybe 30.
Thanks!
I attached one screenshot of the sheet for your reference.
Assuming you do not have more data in the columns to be copied, this should work
Sub copyToOneColumn()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Master")
Dim startCol As Integer
startCol = 3
Dim endCol As Integer
endCol = 10
Dim startRange As Range
Dim ra As Range
For i = startCol To endCol
Set startRange = ws.Range("A1").Offset(0, i - 1)
Set ra = ws.Range(startRange, ws.Cells(Rows.Count, startRange.Column).End(xlUp))
ra.Copy Destination:=ws.Range("B" & Rows.Count).End(xlUp).Offset(2, 0)
Next i
End Sub
You can do a copy (not technically a copy as it doesn't use the clipboard) directly like so:
Range("B1").Resize(Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Rows.Count,1) = Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Value
Effectively you are looking at B1 then resizing that to a range to be the number of columns in column A that are used with this: Range("A1:A" & range("A" & Rows.Count).End(xlUp).Row).Rows.Count
Then you are making this new range in column B = to the values of the same range in column A.
Note, this can be shortened if you are always starting at row 1 but the code I have given you will suffice if you start at a different row.
You may try something like this...
Sub CopyData()
Dim wsMaster As Worksheet
Dim lr As Long, lc As Long, r As Long, c As Long
Application.ScreenUpdating = False
Set wsMaster = Sheets("Master")
lr = wsMaster.Cells(Rows.Count, 1).End(xlUp).Row
lc = wsMaster.Cells(1, Columns.Count).End(xlToLeft).Column
r = lr + 2
If lr <= 9 Then
For c = 3 To lc
wsMaster.Range(wsMaster.Cells(1, c), wsMaster.Cells(lr, c)).Copy wsMaster.Range("B" & r)
wsMaster.Range("A1:A" & lr).Copy wsMaster.Range("A" & r)
r = wsMaster.Cells(Rows.Count, 2).End(xlUp).Row + 2
Next c
End If
Application.ScreenUpdating = True
End Sub
Related
I have made an array for M2:Tx - The x will vary dependent code prior to this.
What I would like to do is have a 'clear contents' function and 'sort' function for this array (m2:tx).
I am just struggling to make the array DYNAMIC. If anyone could help.
I believe it will be something along these lines:
k = sh.Range("A3").End(xlDown).Row 'This will give me the length.
Dim TaskDates As Range
Dim StartCell As Range 'First part of Array
Dim EndCell As Range 'End of Array
Set EndCell = Range("T" & 2 + k) 'maybe 2 or 3
Set StartCell = Range("M2")
Set TaskDates = Range(StartCell, EndCell) 'Dynamic Range
This will work i beleive, but is there a more succinct methodology.
I don't really understand the logic by which you are setting your range.
If you want the last row in the range that starts with M2 to be the same as the last occupied row in Column A, then. in general
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
So to set your range M2:Tx where x = LastRow
Set TaskDates = Range("M2", "T" & Cells(Rows.Count, "A").End(xlUp).Row)
To sort the range, decide how you want it sorted, then record a macro.
Here is one way:
Sub MakeRange()
Dim x As Long, MyDynamicRange As Range
x = 123
Set MyDynamicRange = Range("M2:T" & x)
MsgBox MyDynamicRange.Address(0, 0)
End Sub
I am trying to copy a whole bunch of rows into an archive with VBA. (VBA noob here). I have two sheets, 1 called Active, and the Archive. In active I have a column called Job Number which is what the other data is based off of. I need to copy all the rows where job numbers is not blank and copy each row individually over to my archive sheet where a empty row is available. and then clear the job number cell.
At the bottom is what i have so far. Basically i need to take all rows that have have an nonempty cell in column e.( i tried to count rows until last non empty records --> NumRows) also find the location of the last non empty variable in Archive (lr2) and then i tried a for loop to copy over but it doesn't do anything. Any help would be awesome.
Sub Archiver()
Dim lr As Long, lr2 As Long, r As Long, NumRows As Integer
lr2 = Sheets("Archive").Cells(Rows.Count, "E").End(xlUp).Row
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
For r = 5 To NumRows
Rows(r).Copy Destination:=Sheets("Archive").Range("A" & lr2 + 1)
lr2 = Sheets("Archive").Cells(Rows.Count, "E").End(xlUp).Row
Next r
End Sub
Try this:
Sub Archiver()
Dim lr2 As Long
Dim y As Worksheet, z As Worksheet
Dim copyRng As Range
Set y = Sheets("Active")
Set z = Sheets("Archive")
lr2 = y.Cells(rows.Count, "E").End(xlUp).Row
'Here you select the range of your sheet you want to copy, for me is A:E
Set copyRng = y.Range("A2:E" & lr2)
z.Range("A2:E" & copyRng.rows.Count + 1).Insert Shift:=xlDown
copyRng.Copy z.Range("A2")
y.Range("A2:E" & lr2).ClearContents
End Sub
I have been using StackOverflow for a while now and just love this community. I know I can get an answer for any problem hopefully.
Ok so here is my issue, I have been performing a "Frankenstein" of a script from several posts on this site. I want to copy and paste a column of an Array Formula beneath specific headers until there are no more headers. For example, in the row F5 through W5, if there is a name, I want to copy the range that has an array formula beneath it, say in the range F156:F323, and paste that formula in the name under the G Column, H Column, so on until there are no more names between that range...
Below is my attempt to solve it but I keep getting errors
Dim lastCol As Long
Dim i As Long
Dim ws As Worksheet
Dim Formula As Range
Set ws = Sheets("Main")
lastCol = ws.Range("F" & Columns.Count).End(xlRight).Column
Set Formula = Sheets("Main").Range("F156:F323")
With ws
For i = 6 To lastCol
If len(trim.range("F" & i).Value)) <> 0 then _
.Range(i & 156).formulaarray = 'my formula here'
Next i
End With
Post any questions you may have and thanks!
You are flipping columns and rows in many instances.
Use the Range Object Cells instead of Range. It allows using column references in numbers instead of letters.
Assign the formula directly.
Dim lastCol As Long
Dim i As Long
Dim ws As Worksheet
Dim Frmla As Range
Set ws = Sheets("Main")
lastCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
Set Frmla = ws.Range("F156:F323")
With ws
For i = 6 To lastCol
If Len(Trim(.Cells(5, i).Value)) <> 0 Then
.Range(.Cells(156, i), .Cells(323, i)).FormulaR1C1 = Frmla.FormulaR1C1
End If
Next i
End With
I have different data on multiple rows and columns in Excel and I want all the data to be on a single Column. I tried the Transpose Function but it's not helping me to get what I want.
This is what I have right now:
And this is what I want to get:
Can anyone kindly tell me how I can achieve that? Any built in function or Macro will be helpful. Thanks.
Try this code:
Sub RangetoColumn()
Dim LastRow As Long, LastColumn As Long
Dim CurrentSheet As Worksheet, TargetSheet As Worksheet
Dim i As Long, j As Long, Count As Long
Set CurrentSheet = ThisWorkbook.Worksheets("Sheet1")'-->change Sheet1 to your source sheet
Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")'-->change Sheet2 to your target sheet
LastRow = CurrentSheet.Cells(Rows.Count, "A").End(xlUp).Row
Count = 1
For i = 1 To LastRow
LastColumn = CurrentSheet.Cells(i, Columns.Count).End(xlToLeft).Column
For j = 1 To LastColumn
TargetSheet.Range("A" & Count).Value = CurrentSheet.Cells(i, j).Value
Count = Count + 1
Next j
Next i
End Sub
Code will read Range from Sheet1 and will create a Column in Sheet2.
I think this tutorial should help you : tutorial
you can try that solution for your needs.
Try using & in both cells. Try like this A1&B1 to combine the data in cell A1 and cell B1; copy and paste, then enjoy.
this will have all current sheet cells listed down its column A and cleared all other adjacent columns
Option Explicit
Sub RangeToOneColumn()
Dim lastRow As Long, i As Long, j As Long
Dim rng As Range
Dim myArr As Variant
With ThisWorkbook.Worksheets("Sheet1") '<== change it to your needs
lastRow = .Cells(.rows.Count, "A").End(xlUp).Row
ReDim myArr(0 To lastRow - 1)
For i = 1 To lastRow
Set rng = .Range(.Cells(i, 1), .Cells(i, .Columns.Count).End(xlToLeft))
myArr(i - 1) = Application.Transpose(Application.Transpose(rng))
Next i
.Cells(1, 1).CurrentRegion.ClearContents
j = 1
For i = LBound(myArr) To UBound(myArr)
.Cells(j, 1).Resize(UBound(myArr(i))) = Application.Transpose(myArr(i))
j = j + UBound(myArr(i))
Next i
End With
End Sub
since it uses array, it runs faster than iterating a coping&pasting through cells
I have two workbooks , one is a active list(database) and the other is a project tracker(dashboard).
Both workbooks have a project ID.
I want that the workbook and active list should have a loop to match the exact project IDs.
If the project ID is found in the active list, it would retrieve information from that row and overwrite the existing row in the project tracker,which contains that project ID.
This is an example of the code which i have done, I did something relevant but it does not seem to work :
Sub AAA()
'If Workbooks("Source.xlsm").Sheets("Sheet2").Range("A2").Value = Workbooks("Target.xlsm").Sheets("Sheet1").Range("A2").Value Then
'Workbooks("Source.xlsm").Sheets("Sheet2").Range("B2").Value = Workbooks("Target.xlsm").Sheets("Sheet1").Range("C2").Value
Dim a As Long
Dim lastrow As Long
Dim lastcol As Long
Dim source As Worksheet
Dim target As Worksheet
Set target = Workbooks("Target.xlsm").Sheets("Sheet1")
Set source = Workbooks("Source.xlsm").Sheets("Sheet2")
lastrow = source.Range("A" & target.Rows.Count).End(xlUp).Row
lastcol = target.Cells(2, target.Columns.Count).Column
target.Activate
For a = 2 To 50
If source.Range("A" & a).Value = target.Range("A" & a).Value Then
target.Range("C" & a).Select
Range(ActiveCell, ActiveCell.Offset(0)).Copy
source.Range("B" & a).PasteSpecial
End If
Next a
End Sub
You are misunderstanding how you use the Range object. This .Range("A").Value does not work, you need to include a row number as well, such as .Range("A1").Value.
Your logic assumes that both lists are in exactly the same order. Using the Range.Find method gets round that problem.
Sub AAA()
Dim source As Worksheet
Dim target As Worksheet
Dim cell As Range
Dim cellFound As Range
Set target = Workbooks("Target.xlsm").Sheets("Sheet1")
Set source = Workbooks("Source.xlsm").Sheets("Sheet2")
For Each cell In target.Range("A2:A50")
' Try to find this value in the source sheet
Set cellFound = source.Range("A:A").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cellFound Is Nothing Then
' A matching value was found
' So copy the cell 2 columns across to the cell adjacent to matching value
' Do a "normal" copy & paste
cell.Offset(ColumnOffset:=2).Copy cellFound.Offset(ColumnOffset:=1)
' Or do a copy & paste special values
'cell.Offset(ColumnOffset:=2).Copy
'cellFound.Offset(ColumnOffset:=1).PasteSpecial xlPasteValues
Else
' The value in this cell does not exist in the source
' Should anything be done?
End If
Next
End Sub
Are you aware that you are using different sheets for source and for target?
target.Activate
For a = 2 To 50
If source.Range("A" & a).Value = target.Range("A" & a).Value Then
target.Range("C" & a).EntireRow.Select
Selection.Copy
source.Range("B" & a).PasteSpecial
End If
Next a
Not sure what volume of data you're going to be working with, but you could also use arrays to achieve what you're after.
Option Explicit
Sub AAA()
Dim i As Long, j As Long, k As Integer
Dim source As Worksheet, target As Worksheet
Dim arrTarget() As Variant, arrSource() As Variant
Dim lrowSrc As Long, lcolSrc As Long, lrowTrgt As Long, lcolTrgt As Long
Set target = Workbooks("Book4.xlsb").Sheets("Sheet1")
Set source = Workbooks("Book3.xlsb").Sheets("Sheet1")
lrowSrc = source.Cells(target.Rows.Count, 1).End(xlUp).Row
lcolSrc = source.Cells(2, source.Columns.Count).End(xlToLeft).Column
lrowTrgt = target.Cells(target.Rows.Count, 1).End(xlUp).Row
lcolTrgt = target.Cells(2, target.Columns.Count).End(xlToLeft).Column
target.Activate
arrTarget = target.Range(Cells(2, 1), Cells(lrowTrgt, lcolSrc))
source.Activate
arrSource = source.Range(Cells(2, 1), Cells(lrowSrc, lcolSrc))
target.Activate
For i = LBound(arrTarget, 1) To UBound(arrTarget, 1)
For j = LBound(arrSource, 1) To UBound(arrSource, 1)
If arrTarget(i, 1) = arrSource(j, 1) Then
For k = LBound(arrSource, 2) To UBound(arrSource, 2)
arrTarget(i, k) = arrSource(j, k)
Next k
Exit For
End If
Next j
Next i
target.Range("A2").Resize(UBound(arrTarget, 1), UBound(arrTarget, 2)).Value = arrTarget
End Sub
Working on 12,000 rows of data in the Target workbook and 25,000 in the Source workbook, with 6,000 matches, the code took 9.91 seconds to run.