Copy from workbook 2 and paste to wb1 range

S

simmerer

New Member
Joined
Sep 6, 2017
Messages
33
Hi,.
I have this and it fails at the paste for "Subscript out of range". It would seem I am not properly selecting my destination. Is it my method?

Sub Macro2()
'
' Macro2 Macro
Dim wb1 As Excel.Workbook 'Open PSSLA workbook first
Set wb1 = ThisWorkbook
Dim wb2 As String 'Open Raw Data Workbook next
wb2 = Application.GetOpenFilename("Excel workbooks,*.xls*")

If wb2 = "False" Then
' ' the user clicked Cancel

Else
' the user selected a file; its path+name is in wb2
Application.Workbooks.Open Filename:=wb2
End If

Worksheets("IBM Rational ClearQuest Web").Range("A2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks("wb1").Worksheets("PS").Select (failure point)
Range("A2").Select
Selection.Paste

End Sub
 
Sort by date Sort by votes
Re: Copy from woorkbook 2 and paste to wb1 range

Deleted
 
Last edited:
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Re: Copy from woorkbook 2 and paste to wb1 range

However we can simplify the macro somewhat.
Rather than counting the used rows all the time, we can do that at the start, store the number in a variable (UsdRws) & refer to that throughout.
Also rather than using With Wb2... all the time, that can be done just once, which gives us this
Code: 
Sub PSSLA_CopyPaste_Raw_Data()
'
'
    Dim wb1 As Excel.Workbook 'Open PSSLA workbook first
    Dim wb2 As Workbook
    Dim Fname As String
    Dim UsdRws As Long
    
    Set wb1 = ActiveWorkbook
    
    Fname = Application.GetOpenFilename("Excel workbooks,*.xls*")
    
    If Fname = "False" Then
    ' ' the user clicked Cancel
    Else
    ' the user selected a file; its path+name is in wb2
        Set wb2 = Workbooks.Open(Fname)
    End If
    
    With wb2.Worksheets("IBM Rational ClearQuest Web")
    UsdRws = Cells.Find("*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    '######### Copy/Paste Raw Data columns A:K
        .Range("A2:K" & UsdRws).Copy
        wb1.Worksheets("PS").Range("A2").PasteSpecial xlValues
    
    '######### Copy/Paste Raw Data column L "Date Closed or CN Submitted"
        .Range("L2:L" & UsdRws).Copy
        wb1.Worksheets("PS").Range("M2").PasteSpecial xlValues
    
    ' ######### Copy/Paste Raw Data columns M "IR/CAP Revised Y/N"
        .Range("M2:M" & UsdRws).Copy
        wb1.Worksheets("PS").Range("O2").PasteSpecial xlValues
    
    '######### Copy/Paste Raw Data columns N:P "IRCAP", "IR/CAP Action Status", "IR/CAP Submitted to DHCS"
        .Range("N2:P" & UsdRws).Copy
        wb1.Worksheets("PS").Range("Q2").PasteSpecial xlValues
    
    '######### Copy/Paste Raw Data columns Q "IR-CAP DHCS Date Of Approval"
        .Range("Q2:Q" & UsdRws).Copy
        wb1.Worksheets("PS").Range("V2").PasteSpecial xlValues
    
    '######### Copy/Paste Raw Data columns R:S "Test Results Action Status", "TR Date Submitted to DHCS"
        .Range("R2:S" & UsdRws).Copy
        wb1.Worksheets("PS").Range("AB2").PasteSpecial xlValues
    
    '######### Copy/Paste Raw Data columns T "TR Date of Approval"
        .Range("T2:T" & UsdRws).Copy
        wb1.Worksheets("PS").Range("AF2").PasteSpecial xlValues
    
    '######### Copy/Paste Raw Data columns U:X "CN State", "CN Action Status", "CN Date Submitted to DHCS", "CN DHCS Date of Approval"
        .Range("U2:X" & UsdRws).Copy
        wb1.Worksheets("PS").Range("AJ2").PasteSpecial xlValues
    End With
    
    Range("A2").Select

End Sub
 
Last edited:
Upvote 0
Re: Copy from woorkbook 2 and paste to wb1 range

Very nice, thanks! You have been a great help. I know just enough to be dangerous. Case in point. The code we have been looking at will replace at least 90 minutes of data movement and validation when used with other subs. However this part with a sheet named "CN" is slow, and causes a period on no response about one minute long. this sheet often has formatting or data in the far reaches outside of my data set. So I clean that up first, then standardize the formatting. Can you tell me if anything stands out as being a bad practice?

Sub PSSLA_Standard_Formats_CN_Tab()


'Standardizes formats for CN tab
Sheets("CN").Select
Range("AA:XFD").Select
Selection.Clear
Range("A1000:Z1048576").Select
Selection.Clear
Range("A1:Z1000").Select
With Selection.Font
.Name = "Arial"
.Bold = False
.Size = "10"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.VerticalAlignment = xlTop
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.HorizontalAlignment = xlLeft
End With

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A1").End(xlDown).Select 'Shade column D
Selection.Offset(, 3).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A1").End(xlDown).Select 'Shade column G
Selection.Offset(, 6).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With

Range("A1").End(xlDown).Select 'Shade column J
Selection.Offset(, 9).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A1").End(xlDown).Select 'Shade column M
Selection.Offset(, 12).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A1").End(xlDown).Select 'Shade column P
Selection.Offset(, 15).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A1").End(xlDown).Select 'Shade column S
Selection.Offset(, 18).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A1").End(xlDown).Select 'Shade column V
Selection.Offset(, 21).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A1").End(xlDown).Select 'Shade columns V:W
Selection.Offset(, 22).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Offset(, -1).Resize(, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("A1").Select


End Sub
 
Last edited:
Upvote 0
Re: Copy from woorkbook 2 and paste to wb1 range

Firstly you can get rid of the .select/selections like this
Code: 
    Sheets("CN").Select
    Range("AA:XFD").Clear
    Range("A1000:Z1048576").Clear
    With Range("A1:Z1000").Font
        .Name = "Arial"
        .Bold = False
        .Size = "10"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
If you can do that for the rest of your macro & show the results, I'll take another look.
BUT please post your code between code tags.
In the reply window click the # icon & paste your code inbetween the tags

PS suggest you make a copy of your macro before doing this, incase it goes wrong
 
Last edited:
Upvote 0
Re: Copy from woorkbook 2 and paste to wb1 range

Thanks for the tip on the tag for code. I did not know that. You mod works great. after this last part, I want to go back to the PS sheet, cell A2, and none of my ideas work.
Code: 
.Range("U2:X" & UsdRws).Copy
wb1.Worksheets("PS").Range("AJ2").PasteSpecial xlValues
End With
End Sub
It looks like I should be able to just select the range, but the focus is still on wb2.
 
Upvote 0
Re: Copy from woorkbook 2 and paste to wb1 range

try
Code: 
        .Range("U2:X" & UsdRws).Copy
        wb1.Worksheets("PS").Range("AJ2").PasteSpecial xlValues
    End With
    wb1.Worksheets("PS").Activate
    Range("A2").Select

End Sub
 
Upvote 0
Re: Copy from woorkbook 2 and paste to wb1 range

Perfect! Again, so many thanks! I can be even more dangerous now!
 
Upvote 0
Re: Copy from woorkbook 2 and paste to wb1 range

Glad to help & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

KlausW
  • Solved
copy from a closed Workbook error
Replies
6
Views
475
KlausW
KlausW
Logit
  • Question Question
Search In Other Workbook - Copy/Paste Offset Data To First Workbook - Repeat Process
Replies
7
Views
357
Logit
Logit
S
  • Question Question
VBA Copy/Paste from different workbooks
Replies
1
Views
385
NdNoviceHlp
NdNoviceHlp
G
  • Question Question
Copying and pasting between two workbooks
Replies
1
Views
702
rlv01
R
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
507
sspatriots
S

Forum statistics

Threads
1,224,828
Messages
6,181,201
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top