Cells not being copied to the next available cell - excel

I am trying to record a macro that copies values from 4 cells then pastes them on another sheet that serves as a sort of log. I cannot get the values to paste in a new row though despite using the "Relative References" button when recording the macro. Is there something I can add to the code below to make the values paste in the next available row?
'''
Sub Again()
'
' Again Macro
'
'
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(0, -3).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Select
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
'''

Sub add_value()
Dim wbA As Workbook
Dim wsA As Worksheet
Set wbA = ActiveWorkbook
Set wsA = wbA.Worksheets("Sheet1")
Dim nrow As Long
nrow = 6
Do Until wsA.Range("B" & nrow).Value = ""
wsA.Range("B" & nrow).Value = wsA.Range("B3").Value
wsA.Range("C" & nrow).Value = wsA.Range("C3").Value
Exit Sub
nrow = nrow + 1
Loop
End Sub
This is actually working, now i just have to figure out how to offset it

Related

VBA Macro for Pasting Data In New Row of Table - Excel

I have recorded a macro that is attempting to copy information from cells outside of a table and paste them into a new row in a table on the same sheet. When trying to run the macro I receive "Run-time error '1004': PasteSpecial method of Range class failed." The issue seems to be with the first line stating:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I have a collection of paste special code in this module so I am afraid that this first line might not be the only issue. Below is the code I have so far.
Sub PlaceOrder()
'
' PlaceOrder Macro
'
'
Range("A3").Select
Selection.Copy
Range("Table1[[#Headers],[Balance]]").Select
Selection.End(xlDown).Select
Selection.ListObject.ListRows.Add AlwaysInsert:=False
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Range("C3:E3").Select
Application.CutCopyMode = False
Selection.Copy
Range("C23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 3).Range("A1").Select
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Range("F23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 3).Range("A1").Select
Range("E3").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D3").Select
Selection.ClearContents
Range("C3").Select
Selection.ClearContents
Range("B3").Select
Selection.ClearContents
Selection.ConvertToLinkedDataType ServiceID:=268435456, LanguageCulture:= _
"en-US"
End Sub
Any help will is greatly appreciated!
Edit:
Worksheet
Attached is screenshot of the worksheet I am working with. I would like to be able to paste the values of A3 & C3-F3, and the formula in B3 into the table seen below. A new row needs to be inserted prior to pasting all of this information.
This should work. It's basically just a clearer version of your code.
Sub PlaceOrder()
Dim tbl As ListObject
Dim LastRow As Long
Set tbl = ActiveSheet.ListObjects("Table1")
LastRow = tbl.Range.Rows.Count 'get # of last row
With ActiveSheet
'copy and paste A3
.Range("A3").Copy
tbl.Range(LastRow, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'copy and paste B3
.Range("B3").Copy
tbl.Range(LastRow, 2).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas
'copy and paste C3:F3
.Range("C3:F3").Copy
tbl.Range(LastRow, 3).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'clear value in B3:F3
.Range("B3:F3").ClearContents
End With
End Sub
Your original macro did not work because the system forgot the copied value after this line:
Selection.ListObject.ListRows.Add AlwaysInsert:=False

Loop through list and append results VBA

I have a main sheet, its a dashboard style sheet pulling in information from linked sheets(its used to spot check). All the results for the sheet is driven by one cell(an ID), I have a list of IDs that I want to flow through the cell and then copy the one line of results and append it to some other sheet. I recorded the function to try to explain what im doing.
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[1]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I then did it multiple times to show how the whole process would look:
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[2]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[3]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[4]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
So overall theres three sheets. Data input where the results and functions live, List where contains a list of IDs and Results where I just need to append the one row from Data Input(row32)
You can do something like this:
Dim wsList As Worksheet, wsData As Worksheet, wsResult As Worksheet
Dim c As Range, rwDest As Range
Set wsList = ThisWorkbook.Worksheets("List")
Set wsData = ThisWorkbook.Worksheets("Data Input")
Set wsResult = ThisWorkbook.Worksheets("Result")
Set rwDest = wsResult.Rows(3) 'first destination row
For Each c In wsList.Range("A2:A100").Cells 'for example
If c.Value <> "" Then
wsData.Range("L3").Value = c.Value
wsData.Calculate
rwDest.Value = wsData.Rows(32).Value 'copy row values
Set rwDest = rwDest.Offset(1, 0) 'next destination row
End If
Next c

VBA error PasteSpecial Method of Range Class failed

I have this error all the time, even though I tried removing selection etc. Before this I update some cells and then the code copies and selects 7 rows (it was supposed to select 10) and before pasting gives the error. Where the code gets stuck is
Range("C4:AN" & Range("B5").Value).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Please help
Sub Refresh()
Call Confirm
Dim F As New FDSOfficeAPI_Server
Application.Iteration = True
Application.ScreenUpdating = False
Sheets("Supply Chain").Select
Range("C1:BA10000").Select
V = F.RefreshSelectedFDSCodes
Range("B1").Select
Application.ScreenUpdating = True
Sheets("Supply Chain").Select
Range("C4:AN4").Copy
Range("C4:AN" & Range("B5").Value).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("BD4:CO4").Select
Application.CutCopyMode = False
Selection.Copy
Range("BD4:CO" & Range("BC5").Value).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("DE4:EO4").Select
Application.CutCopyMode = False
Selection.Copy
Range("DE4:EO" & Range("DD5").Value).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
Your code would be easier to maintain if you move the repeated parts to a separate sub. Try something more like this:
Sub Tester()
FillDownFormats Range("C4:AN4"), Range("B5").Value
FillDownFormats Range("BD4:CO4"), Range("BC5").Value
FillDownFormats Range("DE4:EO4"), Range("DD5").Value
End Sub
'Fill down the formats from rngSource to fill total of 'numRows' rows
Sub FillDownFormats(rngSource As Range, numRows As Long)
rngSource.Offset(1, 0).Resize(numRows-1).ClearFormats 'clear any existing formatting
rngSource.Copy
rngSource.Resize(numRows).PasteSpecial _
Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Excel Macro copying poorly formatted data into table

I have been tasked with extracting data out of an Excel sheet that is strangely/poorly formatted. There is far too much data to manually copy out, so I am trying to use a Macro. I am not very skilled with VBA, but I know a little (probably just enough to break something :) ).
I am just working on 1 sheet right now, but there are several sheets, all formatted in the same way. Here is a snippet of what the source data looks like:
I highlighted the cells that I am needing to copy. The rest of the data is not important and won't need to be extracted.
As you can see, the source data is not formatted as traditional rows and columns, to say the least.
I am copying this data into a table that I have set up in a new sheet.
****Edit:**** I updated my code. I realized that the data was formatted to where there are the same amount of spaces between the rows in the data that I need, 14 to be exact. I now have a Do While Loop that increments the Row Index by 14 each time to move to the next record.
This code works, but am I going about this the correct way??? I will need to repeat this process for about 50 sheets, some of which have 1000 or more records.
Sub CopyData()
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Dim DestRow As Long
Dim i As Integer
i = 0
Set SourceSheet = Sheets("Sheet1")
Set DestSheet = Sheets("Data")
Do While i < 100
DestRow = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
SourceSheet.Cells(2 + i, 1).Copy
DestSheet.Range("A" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(2 + i, 2).Copy
DestSheet.Range("D" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(3 + i, 2).Copy
DestSheet.Range("E" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(4 + i, 2).Copy
DestSheet.Range("F" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(2 + i, 7).Copy
DestSheet.Range("C" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(5 + i, 7).Copy
DestSheet.Range("G" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(14 + i, 2).Copy
DestSheet.Range("B" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
i = i + 14
Loop
End Sub
Yes, I think what you are doing is good. You've figured out the pattern and how to increment through it. You probably want to add some kind of check for when you've reached the end of a sheet - the simplest would be to test for a blank in the first line after the Do and exit that loop with an Exit Do which will kick you into an outer loop like For each ws in wb.Worksheets.
This isn't a very technical answer I know, but it seems like you're very close and I didn't want to type all this in a comment.
I am posting the almost final code I came up with here in case it can help any one in the future. It turned out to not be quite as hard as I thought, once I discovered there was equal spacing in the data. Thanks #Doug Glancy for your advice on using Exit Do.
I am sure this is far from a perfect solution. Need to add some error handling/checking. I would appreciate any advice on ways that the code could be improved, or different ways to accomplish this.
Sub CopyData()
Dim DestSheet As Worksheet
Dim DestRow As Long
Dim i As Integer
Set DestSheet = Sheets("Data")
'Loop through all worksheets in the workbook
For Each Worksheet In ActiveWorkbook.Worksheets
'Reset counter variable for each worksheet
i = 0
'Check to make sure we are not on the destination sheet
If Worksheet.Name <> DestSheet.Name Then
'Loop through all rows in the sheet
Do While i < Worksheet.Rows.Count
'Check the contents of the first row in the record to ensure that it contains data
If Worksheet.Cells(2 + i, 1) <> "" Then
'Find the next empty row in the destination sheet to copy to
DestRow = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Copy and paste data, using paste special because of the formatting and formulas in the source
Worksheet.Cells(2 + i, 1).Copy
DestSheet.Range("A" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(2 + i, 2).Copy
DestSheet.Range("D" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(3 + i, 2).Copy
DestSheet.Range("E" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(4 + i, 2).Copy
DestSheet.Range("F" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(2 + i, 7).Copy
DestSheet.Range("C" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(5 + i, 7).Copy
DestSheet.Range("G" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(14 + i, 2).Copy
DestSheet.Range("B" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Add 14 to counter, since the rows are equally spaced by 14
i = i + 14
Else
'If the first row contains no data, then exit the loop
Exit Do
End If
Loop
End If
Next
End Sub

Copying in Excel while picking up multiple rows that are feeding input into the copied Excel formula

I am a starting VBA enthusiast and I would like some help on the below formula as I have no idea how to make sure the formula applies to all rows in the book. As you can see, I have started copying the actual code, but as I have to do this for up to 100 rows this will be too manually.
Thanks
Sub Charts()
' Charts Macro
' Run charts
Range("D7").Value = Range("D11")
Range("E7:G7").Select
Selection.Copy
Range("E11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Value = Range("D12")
Range("E7:G7").Select
Selection.Copy
Range("E12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Value = Range("D13")
Range("E7:G7").Select
Selection.Copy
Range("E13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Value = Range("D14")
Range("E7:G7").Select
Selection.Copy
Range("E14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Is this what you are trying?
Option Explicit
Sub Charts()
Dim i As Long
'~~> Change this to the relevant sheet
With Sheets("Sheet1")
For i = 11 To 14 '<~~ Change 14 to whatever row you want to go to
.Range("D7").Value = .Range("D" & i).Value
.Range("E7:G7").Copy
.Range("E" & i).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
End With
End Sub

Resources