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