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
Related
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
Gods of VBA,
Have been trying all morning to tweak this piece of amateur-VBA (in which case i'm the amateur) to perform as i want.
What is does now is the following; Looks for cell value 1 in Column O on the third sheet in my workbook. When it gets a hit, it copies the row which has 1 in Column O to a new worksheet called "Blad1". It then switches back to my 3rd sheet in the workbook "Doorvoeren".
It will loop and perform the task as wanted, only thing i can't get it to do is copy rows based on a variable in sheet "Doorvoeren". When this value is 5, i want it to copy the row with 1 in column O, and the 4 rows below it. (as example).
Could you please send me in the right direction here? Trying to make it work, but also learn from it in the process.
My code is added in the sample below:
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 500
pasteRowIndex = 5
For r = 3 To endRow
If Cells(r, Columns("O").Column).Value = 1 Then
Rows(r).Select
Selection.Copy
Sheets("Blad1").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
pasteRowIndex = pasteRowIndex + 1
Sheets("Doorvoeren").Select
End If
Next r
End Sub
EDIT: Thank you all for your answers, actually having real trouble to find one that works. To explain again; I need this VBA tweaked in the way that it looks at cell Q3, in sheet "Doorvoeren" to get the number of rows to copy. So, if Q3 is cell value; 5, i want it to to copy the row with number 1 in Column O, in Sheet "Doorvoeren", but also the other four rows below it.
So my 1 in Column O, is just a marker, not the number of rows i want to copy.
Please ask/tell me if i'm not being totally clear.
Here is my solution (slightly ammending your code with annotations)
Sub testIt()
'add another variable (called var)
Dim r As Long, endRow As Long, pasteRowIndex As Long, Var As Long
endRow = 500
pasteRowIndex = 5
For r = 3 To endRow
If Cells(r, Columns("O").Column).Value = 1 Then
'Grab the var number from the Doorvoeren sheet. Var will then determine how many rows need to be copied in each circumstance
Sheets("Doorvoeren").Select
Var = Cells(r, Columns("Q").Column).Value
Rows(r & ":" & r + (Var - 1)).Select
Selection.Copy
Sheets("Blad1").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
pasteRowIndex = pasteRowIndex + Var
Sheets("Doorvoeren").Select
End If
Next r
End Sub
It's recommended if you avoid using Select and ActiveSheet, instead use referenced Sheets and Ranges.
Option Explicit
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
Dim PasteRow As Long
With Sheets("Doorvoeren")
' find last row with data in Column "O" in "Doorvoeren" sheet
endRow = .Cells(.Rows.Count, "O").End(xlUp).Row
For r = 3 To endRow
If .Cells(r, "O").Value = 1 Then
pasteRowIndex = 1
Else
If .Cells(r, "O").Value = 5 Then
pasteRowIndex = 5
End If
End If
' find last row with data in Column "O" in "Blad1" sheet
PasteRow = Sheets("Blad1").Cells(Sheets("Blad1").Rows.Count, "O").End(xlUp).Row
' copy number of rows from "Doorvoeren" sheet to "Blad1" sheet, paste them on the first empty row in "Blad1" sheet
.Range("O" & r).Resize(pasteRowIndex).EntireRow.Copy Destination:=Sheets("Blad1").Range("A" & PasteRow + 1)
Next r
End With
End Sub
I made a slight change upon your explanation.
'====================================================
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
Dim DestR as Range
Dim Rloop as Range
dim RowsCounter as Integer
endRow = 500
pasteRowIndex = 5
RowsCounter = 0
For Each Rloop in Sheets("Doorvoeren").range("O3:O" & endRow)
if Rloop = 1 and RowsCounter=0 then RowsCounter = Rloop.Offset(0, 2)
If Rloop = 1 or RowsCounter > 0 Then
Set DestR = Sheets("Blad1").range("A" & pasteRowIndex)
Rloop.EntireRow.Copy DestR
pasteRowIndex = pasteRowIndex + 1
RowsCounter = RowsCounter - 1
End If
Next Rloop
End Sub
Hope this helps better :)
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
So I'm stumped on this logic for writing a macro and I would love some help!
I have a list of about 1700 different numbers on sheet 2 in column A. I need a macro to find if those numbers exist in in column H in sheet1, and if they do, to populate column U in the same row with a word or character.
Make sense?
I figured out a way to find if column H in sheet1 has those numbers and to delete the rows, but that's not exactly what I'm going for. I was just trying to see if I could suss out the logic from the delete row, but not so much.
Thanks in advance!
The code I have so far is:
The code I have so far is:
Sub DL()
Dim LR As Long, i As Long
With Sheets("Sheet2")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
If IsNumeric(Application.Match(.Range("A" & i).Value, Sheets("Sheet2").Columns("A"), 0)) Then
Try this:
Sub DL()
Dim LR As Long, i As Long
Dim rngList As Range
Set rngList = Sheets("Sheet1").Range("H:H") 'lookup list
With Sheets("Sheet2")
LR = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LR
If IsNumeric(Application.Match(.Cells(i, "A").Value, rngList, 0)) Then
.Cells(i, "U").Value = "Match"
End If
Next i
End With
End Sub
This is my first time to code in VBA.
I have several worksheets in a file and they are in order by dates.
So what I am trying to do is to collect data sets in a worksheet if they have the same period of time.
date1 value1
date2 value2
date3 value3
Since they are in order I just compare the first date values and if they are different it moves on to the next worksheet. If they are the same then copy the value and do the same process until it reaches the last worksheet.
However it copies one worksheet fine but after that Excel freezes.
I would be appreciated if you find any errors or give me other suggestions to do it.
Following is my code:
Sub matchingStock()
Dim sh1 As Worksheet, sh2 As Worksheet
' create short references to sheets
' inside the Sheets() use either the tab number or name
Set sh1 = Sheets("combined")
Dim col As Long
'since first column is for Tbill it stock price should place from the third column
col = 3
Dim k As Long
'go through all the stock worksheets
For k = Sheets("WLT").Index To Sheets("ARNA").Index
Set sh2 = Sheets(k)
' Create iterators
Dim i As Long, j As Long
' Create last rows values for the columns you will be comparing
Dim lr1 As Long, lr2 As Long
' create a reference variable to the next available row
Dim nxtRow As Long
' Create ranges to easily reference data
Dim rng1 As Range, rng2 As Range
' Assign values to variables
lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
Application.ScreenUpdating = False
' Loop through column A on sheet1
For i = 2 To lr1
Set rng1 = sh1.Range("A" & i)
' Loop through column A on sheet1
For j = 2 To lr2
Set rng2 = sh2.Range("A" & j)
' compare the words in column a on sheet1 with the words in column on sheet2
'Dim date1 As Date
'Dim date2 As Date
'date1 = TimeValue(sh1.Range("A3"))
'date2 = TimeValue(sh2.Range("A3"))
sh1.Cells(1, col).Value = sh2.Range("A1").Value
' find next empty row
nxtRow = sh1.Cells(Rows.Count, col).End(xlUp).Row + 1
' copy the word in column A on sheet2 to the next available row in sheet1
' copy the value ( offset(0,1) Column B ) to the next available row in sheet1
sh1.Cells(nxtRow, col).Value = rng2.Offset(0, 6).Value
'when the date is different skip to the next worksheet
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
'sh3.Rows("1:1").Delete
Else
GoTo Skip
End If
Skip:
col = col + 1
Next k
End Sub
I cannot identify a specific error so this is a list of suggestions that may help you identify the error and may help improve your code.
Suggestion 1
Do you think the Else block of If-Then-Else-End-If is compulsory?
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
Else
GoTo Skip
End If
Skip:
is the same as:
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
End If
Suggestion 2
I do not like:
For k = Sheets("WLT").Index To Sheets("ARNA").Index
The value of property Index for a worksheet may not what you think it is. This may not give you the set or sequence of worksheets you expect. Do you want every worksheet except "Combined"? The following should be more reliable:
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> sh1.Name Then
:
End If
Next
Suggestion 3
You use:
.Range("A" & Rows.Count)
.Range("A3")
.Cells(1, col).Value
.Cells(Rows.Count, col)
rng2.Offset(0, 6)
All these methods of identifying a cell or a range have their purposes. However, I find it confusing to use more than one at a time. I find .Cells(row, column) and .Range(.Cells(row1, column1), .Cells(row2, column2)) to be the most versatile and use them unless there is a powerful reason to use one of the other methods.
Suggestion 4
I cannot decypher what this code is attempting to achieve.
You say: "I have several worksheets in a file and they are in order by dates. So what I am trying to do is to collect data sets in a worksheet if they have the same period of time."
If you have set Worksheet("combined").Range("A3").Value to a particular date and you want to collect data from all those sheets with the same value in cell A3 then the outer For-Loop and the If give this effect. But if so, if does not matter how the worksheets are ordered. Also you start checking cell values from row 2 which suggests row 3 is a regular data row.
The outer loop is for each worksheet, the next loop is for each row in "combined" and the inner loop is for each row in the worksheet selected by the outer loop. The middle loop does not appear to do anything but set rng1 which is not used.
Perhaps you can add an explanation of what you are trying to achieve.
Suggestion 5
Are you trying to add an entire column of values from the source worksheets to "Combined". The macro below:
Identifies the next free row in column A of "Combined"
Identifies the last used row in column A of "Sheet2"
Assumes the first interesting row of "Sheet2" is 2.
Adds the entire used range of column A of "Sheet2" (complete with formatting) to the end of "Combined"'s column A in a single statement.
This may demonstrate a better way of achieving the effect you seek.
Sub Test()
Dim RngSrc As Range
Dim RngDest As Range
Dim RowCombNext As Long
Dim RowSrcFirst As Long
Dim RowSrcLast As Long
With Worksheets("Combined")
RowCombNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Set RngDest = .Cells(RowCombNext, "A")
End With
With Worksheets("Sheet2")
RowSrcFirst = 2
RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngSrc = .Range(.Cells(RowSrcFirst, "A"), .Cells(RowSrcLast, "A"))
End With
RngSrc.Copy Destination:=RngDest
End Sub