I have an ActiveSheet script, in where I take raw data move the data to rows Q:V. I have a VBA script that runs and shows where the last row is, in this case the last row is 77.
lastrow = .Cells(.Rows.Count, "Q").End(xlUp).Row
I want to have it where it takes from Q to V last row, copy, and paste it into sheet 1...
I am guessing it will look like this, but I want to verify here first... since my normal sites I go to are down for maintenance for some reason.
Sub test()
Dim wsPOD As Worksheet
Dim wsPOT As Worksheet
Dim wsPOA As Worksheet
Dim cel As Range
Dim lastrow As Long, i As Long, Er As Long
Set wsPOD = Sheets("PO Data")
Set wsPOT = Sheets("PO Tracking")
Set wsPOA = Sheets("PO Archive")
With ActiveSheet
.AutoFilterMode = False
Intersect(.UsedRange, .Columns("A")).Cut .Range("Q1")
Intersect(.UsedRange, .Columns("D")).Cut .Range("R1")
Intersect(.UsedRange, .Columns("C")).Cut .Range("S1")
Intersect(.UsedRange, .Columns("B")).Cut .Range("T1")
Intersect(.UsedRange, .Columns("G")).Cut .Range("U1")
Intersect(.UsedRange, .Columns("F")).Cut .Range("V1")
lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row
Intersect (.UsedRange.Range("Q:V" & lastrow).Copy)
Intersect (wsPOT.Range("B3:H" & lastrow).PasteSpecialxlPasteFormats)
End With
End Sub
This obviously doesn't work, if someone can help me it be appreciated.
Is this what you are trying>
With ActiveSheet
.AutoFilterMode = False
'
'~~> Rest of the code
'
lastRow = .Range("N" & Rows.Count).End(xlUp).Row
.Range("Q1:V" & lastRow).Copy
wsPOT.Range("B3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
xlPasteFormats will only paste the formats and not the value. If you want to paste value then change xlPasteFormats to xlPasteValues
Option Explicit
Sub copylocation()
Dim EC As Long
Dim X As Long
Dim Y As Long
X = Range("B1").End(xlUp).Offset(1, 0).Row
EC = Range("b1").End(xlToLeft).Offset(0, X).Column
Windows("Book2").Activate
Range("b1:AB" & EC).Select
Selection.Copy
Windows("Book1").Activate
Range("b1").Select
ActiveSheet.Paste
End Sub
Related
EDITED
I would like to ask you for help & revision of my VBA code as I am new to VBA.
I have pivot table with 3 columns. Via slicer I choose the items I want to add in new data table, each item must be added 3 times - therefore in the code I used loop 3 times.
The VBA works perfectly when 2 or more items are chosen.
However, when only single item is selected, the VBA crashes because the "selected copied range" does not have the same size as "pasted range" size. Basically, it selects all cells from column "F2:H2" until the end of spreadsheet.
Sub Copy()
Dim i
For i = 1 To 3
StartRange = "F2:H2"
EndRange = "F2:H2"
Set a = Range(StartRange, Range(StartRange).End(xlDown))
Set b = Range(EndRange, Range(EndRange).End(xlDown))
Union(a, b).Select
Selection.Copy
lastrow = ActiveSheet.Cells(Rows.Count, "T").End(xlUp).Row + 1
Cells(lastrow, "T").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
End Sub
How to modify the code, if only single item is selected, it will copy the cells in new data table as well?
I can provide a test file for reference.
Use .End(xlDown) from the header row.
Option Explicit
Sub Copy()
Dim ws As Worksheet, rng As Range
Dim i As Long, lastrow As Long
Set ws = ThisWorkbook.ActiveSheet
Set rng = ws.Range("F2", ws.Range("H1").End(xlDown))
For i = 1 To 3
lastrow = ws.Cells(Rows.Count, "T").End(xlUp).Row + 1
rng.Copy
ws.Cells(lastrow, "T").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
End Sub
or to copy single rows
Sub Copy2()
Const REPEAT = 3
Dim ws As Worksheet, rng As Range
Dim row As Range, lastrow As Long
Set ws = ThisWorkbook.ActiveSheet
Set rng = ws.Range("F2", ws.Range("H1").End(xlDown))
lastrow = ws.Cells(Rows.Count, "T").End(xlUp).row + 1
For Each row In rng.Rows
If Not row.Hidden Then
ws.Cells(lastrow, "T").Resize(REPEAT, row.Columns.Count).Value = row.Value
lastrow = lastrow + REPEAT
End If
Next
End Sub
First of all, I'm new in VBA. Basically, I want to transfer data from one tab to another(within one doc) and paste them transposed.
The code I have here, allows me to move to the next row, after submitting data for the first person.
Sub Submit()
Dim rngSource As Range
Dim rngTarget As Range
Dim iRow As Integer
'tranferring data between macro
Set rngSource = Worksheets("Checklist").Range("b1:b5")
'figuring out the empty row
iRow = Worksheets("Central Tracker").Cells(Rows.Count, 1).End(xlUp).Row + 1
Set rngTarget = Worksheets("Central Tracker").Range("A" & iRow)
rngSource.Copy Destination:=rngTarget.PasteSpecial Paste:= xlPasteValues
End Sub
Basically, I want to add in the transposed paste option but I don't know how I can do that. I will really appreciate your support. Thanks!
Just use Transpose:=True
Dim rngSource As Range
Dim rngTarget As Range
Dim iRow As Integer
'tranferring data between macro
Set rngSource = Worksheets("Checklist").Range("b1:b5")
'figuring out the empty row
iRow = Worksheets("Central Tracker").Cells(Rows.Count, 1).End(xlUp).Row + 1
Set rngTarget = Worksheets("Central Tracker").Range("A" & iRow)
rngSource.Copy
rngTarget.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
I can't figure this out.
Sub Paste1()
Dim NextRow As Range
Set NextRow = Range("A" & Sheets("AMCurrent").UsedRange.Rows.Count + 1)
AMPaste.Range("A3:F3").Copy
AMCurrent.Activate
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing
End Sub
I get an "object error" on row 4, AMPaste.Range("A3:F3").Copy.
I'm assuming you didn't declare your Worksheets, and that you used their name instead of Sheets("SheetName"), but I believe this could be your solution:
Sub Paste1()
Dim NextRow As Long
Dim wsPaste As Worksheet: Set wsPaste = Sheets("AMPaste")
Dim wsCurrent As Worksheet: Set wsCurrent = Sheets("AMCurrent")
NextRow = wsCurrent.Cells(wsCurrent.Rows.Count, "A").End(xlUp).Row + 1
wsPaste.Range("A3:F3").Copy
wsCurrent.Range("A" & NextRow).PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
End Sub
I had the same problem. My worksheet was named "tagsListSheet" and in my script I had a Worksheet variable also named "tagsListSheet". My line of code that produced your error looked like:
Set wwTags = Range(tagsListSheet.Cells(2, 2), tagsListSheet.Cells(lastTagRow, 2))
and when I changed the name of the worksheet variable, it worked.
Set wwTags = Range(tagSheet.Cells(2, 2), tagSheet.Cells(lastTagRow, 2))
Data is filter based on criteria in Col C.
copyRng.AutoFilter Field:=3, Criteria1:="<>"
Filter data is copied to another sheet. It works perfectly when there is at least one cell with data in that column but if the whole column is blank it copies all of the rows, however, it shouldn’t copy anything. What can be done fix this problem? Thank you
Public Sub CopyCLMData()
Dim ws As Worksheet
Dim maxCell As Range
Dim lRowAccess As Long
Dim lRowThisWS As Long
Dim lColThisWS As Long
Dim copyRng As Range, copyRng2 As Range
Dim startRow As Long
Dim startCol As Long
Dim maxXLRows As Long
startRow = 2
startCol = 1
Application.EnableEvents = False
Application.ScreenUpdating = False
'copy header row
wsAll.Rows(1).Copy
wsAccess.Rows(1).PasteSpecial xlPasteValues
'get summary counts only once (outside of the loop)
maxXLRows = wsAccess.Rows.Count 'total rows available in summary sheet
'Copy Colon, Lung, and Melanoma data to summary worksheet (Access)
For Each ws In Worksheets
If ws.name = WS_COLON Or ws.name = WS_LUNG Or ws.name = WS_MELA Then
lRowThisWS = ws.Range("A" & Rows.Count).End(xlUp).Row
Debug.Print lRowThisWS
lColThisWS = 35
'If last row >= StartRow, copy the range
Set copyRng = ws.Range(ws.Cells(startRow - 1, startCol), ws.Cells(lRowThisWS, lColThisWS)) 'data range
'copyRng.AutoFilter Field:=1, Criteria1:="<>*_QC*" 'hide QC rows
copyRng.AutoFilter Field:=3, Criteria1:="<>" 'hide blank rows in col C
If copyRng.SpecialCells(xlCellTypeVisible).Count > 1 Then 'if there is any visible data left
'copy visible range only
Set copyRng = copyRng.SpecialCells(xlCellTypeVisible).Range(copyRng.Cells(startRow, startCol), copyRng.Cells(lRowThisWS, lColThisWS))
copyRng.Copy 'copy values and formats
With wsAccess.Cells(lRowAccess + 1, "A")
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteFormulas
End With
End If
'copyRng.AutoFilter Field:=1
copyRng.AutoFilter Field:=3
End If
End If
Next
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I am trying to get a simple VBA code as part of a Macro that will put in column B the average of the values for each row.
I have code that generates a time series and fills a column per simulation such that each column is a time series starting at column C.
The number of simulations vary so I simply need something that averages the value for each point in time (ie for each row across all simulations) whilst adjusting for the number of simulations that are run (columns that are filled). I would then like it to generate a single graph of all the time series highlighting the average values that are calculated.
Many thanks if you can help!
Here, for example, is the code that takes the values for the time steps from sheet1 and places it in columnA sheet2. I would like the macro to now place the average in the appropriate row down Column B:
Sheets("Sheet1").Select
Range("E5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Try this
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B2:B" & lRow).Formula = _
"=IF(ISERROR(AVERAGE(C2:E2)),"""",AVERAGE(C2:E2))"
End With
End Sub
FOLLOWUP
Try this
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim ColNm As String
Set ws = Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
ColNm = Split(.Cells(, lCol).Address, "$")(1)
.Range("B2:B" & lRow).Formula = "=IF(ISERROR(AVERAGE(C2:" _
& ColNm & _
"2)),"""",AVERAGE(C2:" & _
ColNm & "2))"
End With
End Sub
Try this although there will be lots of different variants on this code:
Sub AddAvgFormula()
With Sheets("Sheet2")
.Range("B2").FormulaR1C1 = "=AVERAGE(RC[1]:RC[3])"
.Range("B2").Copy
.Range("B2:B" & .Cells(Excel.Rows.Count, 1).End(Excel.xlUp).Row).PasteSpecial Excel.xlPasteFormulas
End With
End Sub
At the end of your current code before the End Sub add this:
Call AddAvgFormula
Here's a varient of the original code:
Sub AddAvgFormula()
With Sheets("Sheet2")
.Range("B2") = "=AVERAGE(C2:E2)"
.Range("B2").Copy
.Range("B2:B" & .Cells(Excel.Rows.Count, 1).End(Excel.xlUp).Row).PasteSpecial Excel.xlPasteFormulas
End With
End Sub
Another variant which is shorter but maybe not so intuitive:
Sub AddAvgFormula()
With Sheets("Sheet2")
.Range("B2:B" & .Cells(Excel.Rows.Count, 1).End(Excel.xlUp).Row) = "=AVERAGE(C2:E2)"
End With
End Sub