I'm copying data from one sheet with yesterday's information to another sheet with a table of historical data. The first sheet is actually a vlookup formula, so I need to only paste the value to the historical table. This is what I wrote, but it's saying that the last line doesn't work. Can anyone help?
Option Explicit
Sub Test()
'
' UpdateTablesAndCharts Macro
'
' Keyboard Shortcut: Option+Cmd+t
'
Dim lngNextEmptyRow As Long
Dim lngLastImportRow As Long
Dim shtYstrdy As Worksheet
Set shtYstrdy = ThisWorkbook.Worksheets("Yesterday")
With ThisWorkbook.Worksheets("ICT Historical Crashlytics Data")
lngNextEmptyRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Rows(lngNextEmptyRow).Insert Shift:=xlDown
.Cells(lngNextEmptyRow, "A").Value2 = _
.Cells(lngNextEmptyRow - 1, "A").Value2 + 1
shtYstrdy.Range("AM1:AN1").Copy
Cells("A" & lngNextEmptyRow).PasteSpecial xlPasteValues
End With
End Sub
Cells() format is Cells(Rows,Column) You probably want Range().
When just pasting the values it is faster to just assign it directly.
The Cells() was missing the . in front so it was not assigned to the proper parent sheet.
Use this:
Sub Test()
'
' UpdateTablesAndCharts Macro
'
' Keyboard Shortcut: Option+Cmd+t
'
Dim lngNextEmptyRow As Long
Dim lngLastImportRow As Long
Dim shtYstrdy As Worksheet
Set shtYstrdy = ThisWorkbook.Worksheets("Yesterday")
With ThisWorkbook.Worksheets("ICT Historical Crashlytics Data")
lngNextEmptyRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Rows(lngNextEmptyRow).Insert Shift:=xlDown
.Cells(lngNextEmptyRow, "A").Value2 = _
.Cells(lngNextEmptyRow - 1, "A").Value2 + 1
.Range("A" & lngNextEmptyRow).Resize(1, 2).Value = shtYstrdy.Range("AM1:AN1").Value
End With
End Sub
Related
New VBA user here, the below code matches the 1st column in a worksheet with the 1st column in another worksheet using vlookup then copies the first cell from 1st to 2nd as the screenshots.
Code
Sub solution()
Dim oldRow As Integer
Dim newRow As Integer
Dim lrow_output As Integer 'variable indicating last fulfilled row
Dim WB_Input As Workbook
Dim WB_Output As Workbook
Dim WS_Input As Worksheet
Dim WS_Output As Worksheet
Dim funcStr As String
Set WB_Input = Workbooks("input")
Set WB_Output = Workbooks("output1")
Set WS_Input = WB_Input.Worksheets("input")
Set WS_Output = WB_Output.Worksheets("Sheet1")
With WS_Output
lrow_output = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With WS_Input
funcStr = "=IFERROR(VLOOKUP(" & Cells(1, 1).Address(False, False) & "," & "'[" & WB_Input.Name & "]" & .Name & "'!" & Range(.Columns(1), .Columns(2)).Address & ",2,0),"""")"
End With
With WS_Output
.Cells(1, 2).Formula = funcStr
.Cells(1, 2).Copy
Range(.Cells(1, 2), .Cells(lrow_output, 2)).PasteSpecial xlPasteFormulas
WS_Output.Calculate
Range(.Cells(1, 2), .Cells(lrow_output, 2)).Copy
Range(.Cells(1, 2), .Cells(lrow_output, 2)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
End Sub
Problem: I need the code to copy and paste the all data in the row, not just the first cell.
Problem2:If possible I need the code to scan multiple sheets, not just one so it would be 1 input main workbook sheet and 4 output sheets in the output workbook.
Problem3(Optional): if possible I need the successfully matched and copied rows in the input workbook to be colored to tell them from the unsuccessful matches.
Thank you in advance, I really appreciate all the possible aid.
Here is a quick macro that will take the active cell row copy it and then select specified sheet and paste it in active cell row:
Sub CopyPaste()
'
' CopyPaste Macro
'
'
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets("Sheet#").Select
ActiveCell.Rows("1:1").EntireRow.Select
ActiveSheet.Paste
End Sub
I need to paste special by values the data to my destination. I am not able to work it out. Please can someone help. thank you
Sub ExtractData()
Dim lastrow As Long
Dim erow As Long
Dim i As Long
'Dim mydate As Date
Dim myVIN As String
lastrow = Worksheets("Page1_1").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Page1_1").Select
Worksheets("Page1_1").Range("L1").Select
For i = 2 To lastrow
myVIN = Cells(i, 1)
If myVIN <> "#N/A" Then
erow = Worksheets("OASIS Lookup").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(i, 12).copy Destination:=Sheets("OASIS Lookup").Cells(erow, 1)
End If
Next i
End Sub
'Assign' Instead of PasteSpecial xlPasteValues
Avoid Select and any flavor of Active.
Use variables.
So what if the code is longer, but you will still be able to understand it in a week, a month or even a year. The code will not run faster if it has fewer lines.
Use comments to describe what the code is doing. Not so many as I did but more moderately.
The Code
Option Explicit
Sub ExtractData()
' Define workbook and worksheets.
' Define workbook.
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
' Define Source Worksheet.
Dim src As Worksheet
Set src = wb.Worksheets("Page1_1")
' Define Source Last Row.
Dim srcRow As Long
srcRow = src.Cells(src.Rows.Count, 1).End(xlUp).Row
' Define Target Worksheet.
Dim tgt As Worksheet
Set tgt = wb.Worksheets("OASIS Lookup")
' Define Target Current Row.
Dim tgtRow As Long
tgtRow = tgt.Cells(tgt.Rows.Count, 1).End(xlUp).Row
' Write values from Source Worksheet to Target Worksheet.
' Declare a variable to hold each value in Criteria Column (1).
Dim myVIN As Variant ' Only 'Variant' can accept any value, incl. errors.
' Declare Source Worksheet Rows Counter.
Dim i As Long
' Loop through rows of Source Worksheet.
For i = 2 To srcRow
' Write value in current row of Criteria Column (1) to 'myVIN'.
myVIN = src.Cells(i, 1).Value
' Check if 'myVIN' does not contain an error value.
If Not IsError(myVIN) Then
' Increase Target Current Row.
tgtRow = tgtRow + 1
' Write value in current row of Source Column (12) to current row
' of Target Column (1).
tgt.Cells(tgtRow, 1).Value = src.Cells(i, 12).Value
End If
Next i
' Inform user.
MsgBox "Data copied.", vbInformation, "Success"
End Sub
A rather simple solution could be to replace this line
Cells(i, 12).copy Destination:=Sheets("OASIS Lookup").Cells(erow, 1)
by
Cells(i, 12).copy
Sheets("OASIS Lookup").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues
The following code seems to run smoothly but nothing was copied onto the desired page
Sub a2()
Sheets.Add.Name = "25 degree"
Sheets("25 degree").Move after:=Sheets("data")
Dim x As Long
For x = 2 To 33281
If Cells(x, 1).Value = 25 Then
Cells("x,1:x,2:x,3:x,4:x,5:x,6").Copy
Worksheets("25 degree").Select
ActiveSheet.Paste
End If
Next x
End Sub
I highly recommend not to use .Select or ActiveSheet instead specify the sheet for each Cells() object according to How to avoid using Select in Excel VBA.
Option Explicit
Public Sub DoSomeCoypExample()
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.ActiveSheet
'better define by name
'Set wsSource = ThisWorkbook.Worksheets("source sheet")
Dim wsDestination As Worksheet
Set wsDestination = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets("data")) 'add at the correct position and set it to a variable
wsDestination.Name = "25 degree" 'so you can use the variable to access the new added worksheet.
Dim iRow As Long
For iRow = 2 To 33281 'don't use fixed end numbers (see below if you meant to loop until the last used row)
If wsSource.Cells(iRow, 1).Value = 25 Then
With wsSource
.Range(.Cells(iRow, 1), .Cells(iRow, 6)).Copy Destination:=wsDestination.Range("A1")
'this line will copy columns 1 to 6 of the current row
'note you need to specify the range where you want to paste
'if this should be dynamic see below.
End With
End If
Next iRow
End Sub
If you want to loop until the last used row you can get that with something like
Dim LastRow As Long
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 'last used row in column A
If you want to paste into the next free row in your destination worksheet instead of a fixed range Destination:=wsDestination.Range("A1") you can use the same technique as above to finde the next free row:
Dim NextFreeRow As Long
NextFreeRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
So you can use that in your paste destination:
Destination:=wsDestination.Range("A" & NextFreeRow)
Two questions:
1) I have a spreadsheet (TC) that has data on one page that will be updated daily. There are 28 columns. Essentially I am looking to have the line (row) data cut and paste into a second spreadsheet (Archive) when Col. 28 has a value entered in it. I have the base coding but for some reason it causes Excel to be non-responsive.
I think it might be because the coding goes cell by cell rather than row by row. Can anyone point me in the right direction? (Again, keep in mind, this is a snippet of the coding - I have each Cut and Paste up to Column 28.)
2) The second part of my question is: Will what I have written make sure that when the Command Button is pressed next time, the data will cut and paste to the next blank line. Thank you!
Private Sub CommandButton1_Click()
a = Worksheets("TC").Cells(Rows.Count, 2).End(xlUp).Row
'Dim rng As Range
'Set rng = Worksheets("Archived").Range("A1")
b = 1
For i = 2 To a
If Worksheets(“TC”).Cells(i, 28).Value <> "" Then
'Change # to be the number column of Pt Name
Worksheets(“TC”).Cells(i, 1).Cut
'Change ,# to be the number column of where you want it pasted.
Worksheets(“TC”).Paste Destination:=Worksheets(“Archive”).Cells(b + 1, 1)
'Change ,# to be the number column of SOC
Worksheets(“TC”).Cells(i, 2).Cut
'Change ,# to be the number column of where you want it pasted.
Worksheets(“TC”).Paste Destination:=Worksheets(“Archive”).Cells(b + 1, 2)
b = b + 1
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets(“TC”).Cells(1, 1).Select
End Sub
You can do something like this:
Private Sub CommandButton1_Click()
Dim i as long, b As Long, shtTC as worksheet, shtArch as worksheet
Set shtTC = Worksheets("TC")
Set shtArch = Worksheets("Archive")
'find the first empty row
b = shtArch.Cells(Rows.Count, 2).End(xlUp).Row + 1 'pick a column which will always be populated
For i = 2 To shtTC.Cells(Rows.Count, 2).End(xlUp).Row
If shtTC.Cells(i, 28).Value <> "" Then
'cut the row
shtTc.Cells(i, 1).Resize(1, 28).Cut shtArch.Cells(b, 1)
b = b + 1
End If
Next
Application.CutCopyMode = False
shtTC.Cells(1, 1).Select
End Sub
Here's an example of how to create the kind of copy results you're looking for. Notice that, unless you specifically want to copy/paste all of the formatting with the data, you don't need to use copy/paste. You can perform the copy by assigning the values of the ranges.
Option Explicit
Private Sub CommandButton1_Click()
CopyData ThisWorkbook.Sheets("TC"), ThisWorkbook.Sheets("Archived")
End Sub
Public Sub CopyData(ByRef source As Worksheet, _
ByRef dest As Worksheet, _
Optional ByVal deleteSource As Boolean = False)
'--- calculate and create the source data range
Const TOTAL_COLUMNS As Long = 1
Dim srcRange As Range
Dim lastRow As Long
With source
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set srcRange = .Range("A1").Resize(lastRow, TOTAL_COLUMNS)
End With
'--- determine where the data should go
Dim destRange As Range
With dest
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lastRow > 1 Then lastRow = lastRow + 1
Set destRange = .Cells(lastRow, 1)
Set destRange = destRange.Resize(srcRange.Rows.Count, TOTAL_COLUMNS)
End With
'--- now copy the data
destRange.Value = srcRange.Value
'--- optionally delete the source data
If deleteSource Then
srcRange.Clear
End If
End Sub
I had been using this code for a little while in a workbook, left and come back to revisit and found the code is no longer functioning as it once was. I cannot see any obvious mistakes and wondered if anyone could spot what perhaps would be stopping it running?
Page names and locations remain the same.
The purpose was to take results in Sheet 4 (CAL) and copy each row into a new empty line in RRR. No errors are displaying. Just nothing happens at all.
Sub ca_act()
Dim nextrow As Long
nextrow = Sheet4.Cells(4, "A").End(xlUp).Row + 1
Dim src As Worksheet
Set src = Sheets("CAL")
Dim trgt As Worksheet
Set trgt = Sheets("RRR")
Dim i As Long
For i = 1 To src.Range("y" & Rows.Count).End(xlUp).Row
If src.Range("y" & i) = 1 Then
' calling the copy paste procedure
CopyPaste src, i, trgt
End If
Next i
Application.ScreenUpdating = True
End Sub
' this sub copies and pastes the entire row into a different sheet
' below the last used row
Private Sub CopyPaste(ByRef src As Worksheet, ByVal i As Long, ByRef trgt As Worksheet)
src.Activate
src.Rows(i & ":" & i).Copy
trgt.Activate
Dim nxtRow As Long
nxtRow = trgt.Range("y" & Rows.Count).End(xlUp).Row + 1
trgt.Rows(nxtRow & ":" & nxtRow).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Wrong Sheet or Column
Some Guess Work
The following line means that you will check values in column "A"
Dim nextrow As Long
nextrow = Sheet4.Cells(4, "A").End(xlUp).Row + 1
which was probably your first idea. BTW you should comment it out because it's useless.
Later you write
For i = 1 To src.Range("Y" & Rows.Count).End(xlUp).Row
which means you're checking column 'Y'. Are you sure about that?
I would consider the following:
You're checking for values in the wrong column.
Your sheets CAL and RRR might be wrong, maybe you have moved the name CAL e.g. to Sheet2 where there is no data.
In sheet 'RRR', you might have some unwanted data below in column 'Y' i.e. if you have accidentally put some data in a cell when it goes up it will stop at that cell and go one row down and write from there and you're not seeing it.
This is happening in different workbooks.
What's this all about
Application.ScreenUpdating = True
when
Application.ScreenUpdating = False
is nowhere to be found.
Here is the simplification of your second sub:
Private Sub CopyPaste(src As Worksheet, i As Long, trgt As Worksheet)
src.Rows(i).Copy (trgt.Rows(trgt.Range("Y" & Rows.Count).End(xlUp).Row + 1))
End Sub
Simplification
Constants at the beginning of the code are lifesavers as you will probably see soon.
It is customary to release object variables when they're not needed anymore or at least at the end of the code. The following codes don't use any object variables which is achieved using the Parent property.
'*******************************************************************************
' Checks a column for a specified value, and each time it is found copies
' the entire current row to another worksheet below its last used row, using
' the CopyPaste_Simple Sub.
'*******************************************************************************
Sub ca_act_Simple()
Application.ScreenUpdating = False
Const strSource As Variant = "CAL" ' Source Worksheet Name/Index
Const strTarget As Variant = "RRR" ' Target Worksheet Name/Index
Const vntSourceCol As Variant = "Y" ' Source Column Letter/Number
Const lngSourceRow As Long = 1 ' Source First Row
Const vntSearch as Variant = 1 ' Search Value
Dim intRow As Long ' Row Counter
With ThisWorkbook.Worksheets(strSource)
For intRow = lngSourceRow To _
.Cells(.Rows.Count, vntSourceCol).End(xlUp).Row
If .Cells(intRow, vntSourceCol) = vntSearch Then
' calling the copy paste procedure
CopyPaste_Simple .Parent.Worksheets(strSource), intRow, _
.Parent.Worksheets(strTarget)
End If
Next
End With
Application.ScreenUpdating = True
End Sub
'*******************************************************************************
'*******************************************************************************
' Copies the entire row to another worksheet below its last used row calculated
' from a specified column.
'*******************************************************************************
Sub CopyPaste_Simple(Source As Worksheet, SourceRowNumber As Long, _
Target As Worksheet)
' It is assumed that the Target Worksheet has headers i.e. its first row
' will never be populated.
Const vntTargetCol As Variant = "Y" ' Target Column Letter/Number
With Target
Source.Rows(SourceRowNumber).Copy (.Rows(.Cells(.Rows.Count, _
vntTargetCol).End(xlUp).Row + 1))
End With
End Sub
'*******************************************************************************
Improvement
To improve we will get rid of the second sub:
'*******************************************************************************
' Checks a column for a specified value, and each time it is found copies
' the entire current row to another worksheet below its last used row
' calculated from a specified column.
'*******************************************************************************
Sub ca_act_Improve()
Application.ScreenUpdating = False
Const strSource As Variant = "CAL" ' Source Worksheet Name/Index
Const strTarget As Variant = "RRR" ' Target Worksheet Name/Index
Const vntSourceCol As Variant = "Y" ' Source Column Letter/Number
Const vntTargetCol As Variant = "Y" ' Target Column Letter/Number
Const lngSourceRow As Long = 1 ' Source First Row
Const vntSearch as Variant = 1 ' Search Value
Dim intRow As Long ' Row Counter
With ThisWorkbook.Worksheets(strSource)
For intRow = lngSourceRow To _
.Cells(.Rows.Count, vntSourceCol).End(xlUp).Row
If .Cells(intRow, vntSourceCol) = vntSearch Then
With .Parent.Worksheets(strTarget)
.Parent.Worksheets(strSource).Rows(intRow).Copy _
(.Rows(.Cells(.Rows.Count, vntTargetCol).End(xlUp).Row + 1))
End With
End If
Next
End With
Application.ScreenUpdating = True
End Sub
'*******************************************************************************
In this improved version it is best visible that you are using column 'Y' in both worksheets, which might be the cause of your trouble.
The Second Sub
I think it's better to add the fourth argument:
'*******************************************************************************
' Copies an entire row to another worksheet below its last used row.
'*******************************************************************************
Sub CopyPaste_Improve(Source As Worksheet, SourceRowNumber As Long, _
Target As Worksheet, TargetColumnLetterNumber As Variant)
' It is assumed that the Target Worksheet has headers i.e. its first row
' will never be populated.
With Target
Source.Rows(SourceRowNumber).Copy (.Rows(.Cells(.Rows.Count, _
TargetColumnLetterNumber).End(xlUp).Row + 1))
End With
End Sub
'*******************************************************************************