I have been given a large spreadsheet with many VBA macros to convert (to a reformatted source workbook).
Below is am example of a simple copy & paste operation, Using the new source I have to target the paste target to start on row 3 (vs row 1). So I have to convert the .Columns operator to a .Cells operator. For example: change:
Set r = thwb.Sheets(8).Columns("p") (r is a range, thwb is this workbook used as a target)
to:
for example:
Set r = thwb.Sheets(8).Cells("p3") to start the Paste on Row 3.
Set SourceSh = Sourcewb.Sheets("my data")
SourceSh.Columns("a5").Copy
r.PasteSpecial xlPasteValues, , , False
When I do this, I get the error msg: ' application or object designed error '
What am I not doing correctly?
Thanks,
Don
Sample code (after changing from .Columns to .Cells ):
Sub Stocks()
Dim Sourcewb As Workbook
Dim SourceSh As Worksheet
Dim thwb As Workbook
Dim r As Range
Set thwb = ThisWorkbook
Set r = thwb.Sheets(8).Cells("p3")
Err.Clear
On Error GoTo errhandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
FilePath = "C:\Users\DonO\Documents\FIRMS\Test\QRM\"
Filename = Dir(FilePath & "*.xlsx")
Do While Filename <> ""
'
' only one workbook in source directory.
'
If Filename = thwb.Name Then GoTo nxt
If Filename & ".xlsx" = thwb.Name Then GoTo nxt
Set Sourcewb = Workbooks.Open(FilePath & Filename, False)
Set SourceSh = Sourcewb.Sheets("Risk by Securities")
SourceSh.Columns("a:d").Copy
r.PasteSpecial xlPasteValues, , , False
Set r = thwb.Sheets(8).Cells("aa3")
SourceSh.Columns("e:g").Copy
r.PasteSpecial xlPasteValues, , , False
Set r = thwb.Sheets(8).Cells("x3")
SourceSh.Columns("i:j").Copy
r.PasteSpecial xlPasteValues, , , False
Set r = thwb.Sheets(8).Cells("af3")
SourceSh.Columns("k:s").Copy
r.PasteSpecial xlPasteValues, , , False
Set r = thwb.Sheets(8).Cells("ad3")
SourceSh.Columns("j").Copy
r.PasteSpecial xlPasteValues, , , False
Set r = thwb.Sheets(8).Cells("z3")
SourceSh.Columns("s").Copy
r.PasteSpecial xlPasteValues, , , False
Workbooks(Filename).Close SaveChanges:=False
nxt:
Filename = Dir
Loop
Set Sourcewb = Nothing
Set SourceSh = Nothing
Set thwb = Nothing
errhandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
If Err.Number <> 0 Then
MsgBox "An error has occurred." & vbNewLine & Err.Description
End If
Sheets("Control").Select
Range("A1").Select
End Sub
Our community of experts have been thoroughly vetted for their expertise and industry experience.
The Distinguished Expert awards are presented to the top veteran and rookie experts to earn the most points in the top 50 topics.