I have a code that copies column of data from one sheet and to another. I would like integrate a do loop so that I don't have to repeat the same commands for each column.
Dim LastRow As Long
Sheets("PWR 2 DATA CAPTURE SHEET Shared").Select
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'MsgBox LastRow
Dim x As Integer
Sheets("PWR 2 DATA CAPTURE SHEET Shared").Select
Dim Copyrange1 As String
Startrow = 3
Let Copyrange1 = "B" & Startrow & ":" & "B" & LastRow
Range(Copyrange1).Select
Selection.Copy
Sheets("PWR2 data capture sheet ").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I want '1' after copyrange to change until '20', and 'B' to change from C, D, E,F,G,H,I,... Until 'AA' which is corresponds to the columns excel.
Any help will be appreciated. Thanks
Related
This code worked once and then stopped. It runs with no action or errors.
I would like if column "a" of the "export" sheet has a yes to copy the cells from B to J to the next clear line in workbook MOSTEST sheet1 (named 11.2022).
Sub DateSave()
Dim LastRow As Integer, i As Integer, erow As Integer
LastRow = Worksheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 1).Value = "YES" Then
Range(Cells(i, 2), Cells(i, 10)).Select
Selection.Copy
Workbooks.Open Filename:="F:\Orders\MOSTEST.xlsx"
Worksheets("11.2022").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub
If changed the "Worksheets("11.2022").Select" to sheet1 which I would prefer as I wouldn't have to change it every month.
You should try to avoid using select, see other post
I adjusted your code where needed, I'm still trying to figure out best practice (i.e. it would be better adding the cell ranges to a range variable and then pasting them in one go but I'm not quite there yet) when it comes to minimizing code so if others can do better, feel free :)
Sub DateSave()
Dim LastRow As Long, i As Long, erow As Long
Dim wsStr As String
Dim ws As Worksheet, wsC As Worksheet
Dim wb As Workbook, wbM As Workbook
LastRow = Worksheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row
Set wb = ActiveWorkbook
Set wsC = wb.Sheets("EXPORT")
Workbooks.Open Filename:="F:\Orders\MOSTEST.xlsx" 'Don't keep opening and saving/closing your workbook per copy, that would heavily increase runtime
Set wbM = Workbooks("MOSTEST.xlsx")
wsStr = Month(Date) & "." & Year(Date)
Set ws = wbM.Worksheets(wsStr) 'If your currentmonth will always be the first sheet then you can use wbM.Sheets(1)
erow = ws.Cells(Rows.Count, 1).End(xlUp).Row
wb.Activate
For i = 1 To LastRow
If wsC.Cells(i, 1).Value = "YES" Then
erow = erow + 1
wsC.Range(wsC.Cells(i, 2), wsC.Cells(i, 10)).Copy 'avoid select
ws.Range("A" & erow).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next i
wbM.Save
wbM.Close
Application.CutCopyMode = False
End Sub
If you have questions, feel free to ask!
I am not sure sure what I am doing wrong in trying to copy a range from one worksheet to another. Trying to copy from "LeadSheet" to "HistoricalDataSheet". Leadsheet Data will always start with Row 5 and copy the full rows until the last row. Then paste into the row after the last row on "HistoricalDataSHeet" and format the first column for date:
Sub CopyToHistorical()
Dim a, LR As Integer
With Worksheets("LeadSheet")
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Worksheets("LeadSheet")
**.Range("5:LR").Copy**
'this is where I am getting there error'
End With
With Worksheets("HistoricalLeadData")
a = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Sheets("HistoricalLeadData").Range("A" & a + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
With Sheets("HistoricalLeadData")
.Range(.Range("A" & a + 1), .Range("A" & a + 1).End(xlDown)).NumberFormat = "m/d/yyyy"
End With
End Sub
I have a mix of codes I found that seemed to work but no longer does after changing a few things. I am trying to copy values from a range on one sheet ("Sheet1") and paste them transposed onto another ("Sheet2"). The catch is that I only want to paste them into the row that the value in column A equals the value in ("B2") on the same sheet. Also, this value will be repeated throughout column A, but I only need it to paste to the row between rows 11 and 29. Here is what I have so far:
Sub PasteData()
Range("O3:O44").Select
Selection.copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Unprotect ("Password")
Dim nRow As Long
Dim nStart As Long, nEnd As Long
For nRow = 11 To 29
If Range("A" & nRow).Value = Range("b2").Value Then
nStart = nRow
Exit For
End If
Next nRow
For nRow = nStart To 29
If Range("a" & nRow).Value <> Range("b2").Value Then
nEnd = nRow
Exit For
End If
Next nRow
nEnd = nEnd - 1
Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Sheet2").Protect Password:="Password", DrawingObjects:=True, Contents:=True, Scenarios:=False
Worksheets("Sheet3").Activate
Range("B13").Select
End Sub
I have noticed on your code that you have not referenced the sheet of Range("O3:O44"). So when you run the code, it will Select and Copy the Range("O3:O44")of the active sheet.
To avoid this confusion, avoid using .Select and .Activate as much as possible especially when dealing with multiple sheets. When referencing Ranges, always include the sheet you are targeting to.
So instead of:
Range("O3:O44").Select
Selection.Copy
Do it like this:
Worksheets("Sheet1").Range("O3:O44").Copy
Now to answer your problem, you need to indicate what sheet Range("O3:O44") is from.
Then move this code on the line just before pasting it.
'range to copy with sheet reference
Worksheets("Sheet1").Range("O3:O44").Copy
'range where previous range will be pasted, also with sheet reference
Worksheets("Sheet2").Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Upon trying your code, this is the solution to the error you encounter.
I have a table in Sheet1 of a workbook and several rows of the table will have #N/A as their value of column N. I would like to find a way to have a vba macro find all rows that have #N/A in column N then copy the values from column M and L of those rows to the bottom of another table on Sheet2 of the same workbook.
ActiveSheet.ListObjects("SEC_Data").Range.AutoFilter Field:=14, Criteria1:= _
"#N/A"
Range("M88343:M88351").Select
Selection.Copy
Sheets("LKUP_Client Name").Select
Range("B2").Select
Selection.End(xlDown).Select
Range("B" & ActiveCell.Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("company_2018 thru2019_gim").Select
Range("L88343:L88351").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("LKUP_Client Name").Select
Range("C").Select
Selection.End(xlDown).Select
Range("C" & ActiveCell.Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
The way I would approach this is to first iterate through column N on sheet 1, when #N/A found then copy the cells and paste in corresponding location on sheet 2. Something like the below:
Sub CopyProcedure()
Dim i As Long
Dim lRow1 As Long, lRow2 As Long
Dim wsSheet1 As Worksheet, wsSheet2 As Worksheet
Set wsSheet1 = Sheets("Sheet 1")
Set wsSheet2 = Sheets("Sheet 2")
lRow1 = wsSheet1.Range("N" & wsSheet1.Rows.Count).End(xlUp).Row
'assuming your data starts in the first row
'iterate to the last row of column n
For i = 1 To lRow1
'look for the #N/A text
If wsSheet1.Range("N" & i).Text = "#N/A" Then
'adjust this to suit which column in sheet 2 you need
lRow2 = wsSheet2.Range("A" & wsSheet2.Rows.Count).End(xlUp).Row + 1
'when text found copy required cells
wsSheet1.Range("L" & i, "M" & i).Copy
'paste cell values in required location on sheet 2
'NOTE THIS WILL PASTE IN THE LAST ROW SPECIFIED ON SHEET 2 AND IN COLUMN A
'adjust as you see fit
wsSheet2.Range("A" & lRow2).PasteSpecial xlPasteValues
'empty clipboard
Application.CutCopyMode = False
End If
Next i
Set wsSheet1 = Nothing
Set wsSheet2 = Nothing
End Sub
This is by no means the most efficient way to do it, but I am sure it will get the job done if I understand your problem correctly.
Also, caveat, I haven't tested or debugged this. :)
I have a sheet with a range of A12:N112, Column A is my trigger column (1 or ) based on changing criteria). The first bit of my macro which works sorts this range to all the rows with a 1 are at the top of the range. It then opens the destination sheet as well.
The next bit of code below, needs to copy cells B:L for each row with a 1 in column A and paste that into the first empty row in the destination sheet starting at column D. This then generates a number which the then copied and pasted back into the first sheet in column M of that specific row. This then needs to loop until all of the rows with a 1 in column A have been processed.
Can anyone help, here is my code, which runs but nothing is copied or pasted.
Dim lr As Long lr = Sheets("Data Entry").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step 1
If Range("AB" & r).Value = "1" Then
Rows(r).Copy.Range ("A" & lr2 + 1)
Windows("Serialisation Log.xlsx").Activate
Sheets("SNo Log").Select
Range("D" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Serialisation Log.xlsx").Activate
Sheets("SNo Log").Select
Range("A" & Rows.Count).End(xlUp).Offset(-1).Select
Selection.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Range("A" & Rows.Count).End(xlUp).Offset(0).Select
Selection.Copy
Windows("Serialisation Generator rev 1.xlsm").Activate
Worksheets("Data Entry").Select
Range("N").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If Range("AB" & r).Value = "0" Then
Range("I4").Select
ActiveCell.FormulaR1C1 = "Serial No. Issue complete for this OA"
End If
Range("F5").Select
Next r
Any help will be greatly appreciated.