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
Related
I have the code below and what I'm trying to accomplish is:
Remove all the filtered results and create a new table without the filtered results. The problem with this code is that every time when including a new sheet I have to add this line of code for it. Is there any way to workaround this? I've tried using For Each...Next statement but didn't have any success with it.
Edit: the Sheet1, Sheet2 etc. are created earlier in the macro only for this purpose.
Sub macro
Worksheets("cat").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Worksheets("Sheet1").Paste
Worksheets("cat").Delete
Worksheets("Sheet1").Name = "cat"
Worksheets("dog").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Worksheets("Sheet2").Paste
Worksheets("dog").Delete
Worksheets("Sheet2").Name = "dog"
Worksheets("meow").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Worksheets("Sheet3").Paste
Worksheets("meow").Delete
Worksheets("Sheet3").Name = "meow"
Worksheets("bark").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet4").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Worksheets("Sheet4").Paste
Worksheets("bark").Delete
Worksheets("Sheet4").Name = "bark"
End Sub
Please, try the next code:
Sub macroIterateSh()
Dim sh As Worksheet, shNew As Worksheet, shName As String
For Each sh In ActiveWorkbook.Sheets
If sh.ListObjects.Count > 0 Then 'for the case of some other sheets not containing a list object...
Set shNew = Worksheets.Add(Before:=sh)
sh.ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
shNew.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
shNew.Paste
shName = sh.Name: sh.Delete
shNew.Name = shName
End If
Next
End Sub
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
I am working on the following code in VBA excel and i get the compile error "sub or function not defined"
The code is meant to copy the cells and paste their transpose at a certain offset.
Any help would be highly appreciated.
Code
Sub copy_paste()
ActiveCells.Copy
Offset(-1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Offset(3, -1).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Offset(-2, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Offset(1, 0).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.ClearContents
End Sub
Thanking in advance, here is the code along with the error:
Try this code, please. It avoids selecting, which consumes Excel resources, without any benefit. Offset makes sense only if it references a range:
Sub testCopy()
Dim sh As Worksheet, rng As Range
Set sh = ActiveSheet 'use here your sheet
Set rng = ActiveCell 'use here what range you need
rng.Copy
rng.Offset(-1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
sh.Range(rng.Offset(3, -1), rng.Offset(3, -1).End(xlToRight)).Copy
rng.Offset(-2, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
sh.Range(rng.Offset(1, 0), rng.Offset(1, 0).End(xlToRight)).ClearContents
End Sub
Use offset in vba like this : Range("A1").Offset(1, 1).Select .
in your code you used offset without refrence range address
I'm trying to add a condition to a copy and paste macro where it copies a row from table1 and pastes it onto table2 if the row in table1 is red.
I've tried:
Sub ColdLake1()
If Range("B55").Interior.ColorIndex = 3 Then
Range("B55:H55").Select
Selection.Copy
Range("C140").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
It returns nothing. Any ideas?
Thanks (I'm quite new to all this).
This worked for me:
Sub ColdLake1()
With ActiveSheet
Debug.Print "ColorIndex", .Range("B55").Interior.ColorIndex
If .Range("B55").Interior.ColorIndex = 3 Then
.Range("B55:H55").Copy
With .Range("C140")
.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
End If
End With
End Sub
If your code isn't doing anything it may be because the color isn't what you think it is, or for some reason your code is not entering the If block. Put some breakpoints and see what is going on. https://www.excel-easy.com/vba/examples/debugging.html
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