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
Related
I have this below macro code that performs a transpose a range of cells.
Sub Macro45()
'
' Macro45 Macro
' r3
'
' Keyboard Shortcut: Ctrl+e
'
Range("F2:G8").Select
Selection.Copy
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
I am trying to see how could I repeat the same process for entire range of rows. My dataset has about 10000 rows and I want to perform the same tasks over the entire range.
It seems you taking particular steps of 7 rows. So maybe try:
Sub Test()
Dim lr As Long, x As Long
With ThisWorkbook.Worksheets("Sheet1") 'Change accordingly
'Find last used row
lr = .Cells(.Rows.Count, 6).End(xlUp).Row
'Step through data and transpose values
For x = 2 To lr Step 7
.Cells(x, 8).Resize(2, 7).Value = Application.Transpose(.Range(.Cells(x, 6), .Cells(x + 6, 7)).Value)
Next x
End With
End Sub
Or if you really interested in copy-paste values and format:
Sub Test()
Dim lr As Long, x As Long
With ThisWorkbook.Worksheets("Sheet1") 'Change accordingly
'Find last used row
lr = .Cells(.Rows.Count, 6).End(xlUp).Row
'Step through data
For x = 2 To lr Step 7
.Range(.Cells(x, 6), .Cells(x + 6, 7)).Copy
.Cells(x, 8).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next x
End With
End Sub
Here's another solution:
Sub main()
Dim rngSrc As Range
Set rngSrc = Range("F2:G8")
While (rngSrc.Cells(1, 1).Value2 <> "")
transpose rngSrc
Set rngSrc = rngSrc.Offset(7, 0)
Wend
End Sub
Sub transpose(rngSrc As Range)
rngSrc.Copy
rngSrc.Cells(1, 2).Offset(0, 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, transpose:=True
End Sub
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 am trying to copy the same row of information from a sheet called "Report" (numbers will change), and paste the values into a sheet "Data" that has headers in the first row.
I tried piecing together some code from various questions.
Here is my code:
Sub Insert_Data()
'
' Insert_Data Macro
Sheets("Report").Range("B9:F9").Copy
Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub PSData_Transfer()
Sheets("Report").Range("B9:F9").Copy
Dim lastrow As Long
lastrow = Sheets("Data").Range("A65536").End(xlUp).Row
Sheets("Data").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
You may have to modify this a little bit to work with your code, but feel free to use mine that I'm using in my current worksheet and it works perfect!
Sub Insert_Data()
For R = LR To 2 Step -1 ' Change the 2 in "To 2" to the row just below your header,
' but typically row 2 is the second cell under header anyways
Call CopyTo(Worksheets(2).Range("B" & R & ":C" & R), Worksheets(1)Range("A:B"))
Next R
End Sub
Private Function CopyTo(rngSource As Range, rngDest As Range)
LR = rngDest.cells(Rows.Count, 1).End(xlUp).row
rngDest.cells(LR + 1, 1).value = rngSource.cells(1, 1).value
rngDest.cells(LR + 1, 2).value = rngSource.cells(1, 2).value
End Function
I don't like to use the copy method as it's slow and it likes to copy all the extra jargin, where as getting the value is much faster and it's retrieving ONLY the value
I have a form where you fill stuff in and a specific part of it should be copied to another sheet at the end of the list.
With Sheets("Sheet1")
If Application.WorksheetFunction.CountA(.Columns(2)) <> 0 Then
lastrow = .Cells(rows.Count, "B").End(xlUp).Row
Else
lastrow = 1
End If
.Cells(lastrow + 1, "B") = "my new value"
End With
I have this code to find the last row and paste/write "my new value" in it.
But i need that it pastes more than just one cell. I just need that it selects that part where it writes "my new value" in. I should be able to do the rest
I'm now using the code below. But it still copies stuff from the sheet "Tabelle3" but it should copy the stuff from the sheet "Tabelle2"
Private Sub CommandButton1_Click()
Dim lastRow As Long
With Sheets("Tabelle3")
If Application.WorksheetFunction.CountA(.Columns(1)) <> 0 Then
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1 '<~~ Add 1 here and not as you are doing
Else
lastRow = 1
End If
Sheets("Tabelle2").Select
Range("B85:S85").copy
Sheets("Tabelle3").Select
'~~> Paste special
.Range("C" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End Sub
You have to find the last empty row and then simply do a paste or pastespecial as shown below.
Sub Sample()
Dim lastRow As Long
With Sheets("Sheet1")
If Application.WorksheetFunction.CountA(.Columns(2)) <> 0 Then
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row + 1 '<~~ Add 1 here and not as you are doing
Else
lastRow = 1
End If
Range("Z10:Z100").Copy
'~~> Paste special
.Range("B" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End Sub
The above code will copy the range "Z10:Z100" and do a pastespecial on the next available row in Col B. If you do not want to do a pastespecial and want to do a direct paste then see this
Sub Sample()
Dim lastRow As Long
With Sheets("Sheet1")
If Application.WorksheetFunction.CountA(.Columns(2)) <> 0 Then
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row + 1 '<~~ Add 1 here and not as you are doing
Else
lastRow = 1
End If
Range("Z10:Z100").Copy .Range("B" & lastRow)
End With
End Sub
This is what I have:
I am trying to get excel to copy only the cells that i have selected and pasted on the next blank line in another spreadsheet.
But in the code below, it fixed the range of cell being copied. How should i change my code so that it can be a dynamic range?
Sub CopyPaste()
Range("A6:E6").Select
Selection.Copy
Sheets("Sheet2").Select
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lMaxRows + 1).Select
End Sub
Remove the statement
Range("A6:E6").Select
This statement selects the fixed range.
Try this
Sub CopyPaste()
Dim sht As Worksheet
Dim rngTarget As Range
Dim lMaxRows As Long
Selection.Copy
Set sht = Sheets("Sheet2")
lMaxRows = sht.Cells(Rows.Count, "A").End(xlUp).Row
Set rngTarget = sht.Range("A" & lMaxRows + 1)
rngTarget.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lMaxRows = sht.Cells(Rows.Count, "A").End(xlUp).Row
sht.Activate
sht.Range("A" & lMaxRows + 1).Select
End Sub
I have rewritten the code to specify exactly which cells and ranges are used. If not, it will apply selections on the sheet that is open (active) at that moment.
In my experience, using .Select is error-prone so I try to avoid it as much as possible.