Copy Data from a column on a sheet and paste to a specific spot on another sheet

C

Cranman2127

New Member
Joined
Sep 2, 2016
Messages
36
Hello,

I'm trying to figure out how to copy the data in column I (9) from one worksheet 'fitment' starting in row 2. And pasting any data found up until the first blank in column I (9) into cell A30 on a worksheet called 'Sheet1'.

The data starts on "Fitment" as a formula, the first block of code is to run the forumula and copy the values into column I (9).

'Define Worksheets
Dim sh1 As Worksheet
Set sh1 = Worksheets("Sheet1")
Dim ft As Worksheet
Set ft = Worksheets("Fitment")




'Run Concat Formula
ft.Select
Columns(7).Select
Selection.value = Selection.FormulaR1C1

'Copy Concat Value and Paste
ft.Select
Columns(7).Select
Selection.Copy
ft.Select
Columns(9).Select
Selection.PasteSpecial Paste:=xlPasteValues

Any Help would be greatly appreciated.
Thank you!
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Sort by date Sort by votes
How about
Code: 
Sub Cranman()
   Dim UsdRws As Long
   With Sheets("Fitment")
      UsdRws = Range("G" & Rows.Count).End(xlUp).Row
      .Range("I2:I" & UsdRws).Value = Range("G2:G" & UsdRws).Value
      Sheets("Sheet1").Range("A30").Resize(UsdRws - 1).Value = .Range("I2:I" & UsdRws).Value
   End With
End Sub
 
Upvote 0
Fluff said:
How about
Code: 
Sub Cranman()
   Dim UsdRws As Long
   With Sheets("Fitment")
      UsdRws = Range("G" & Rows.Count).End(xlUp).Row
      .Range("I2:I" & UsdRws).Value = Range("G2:G" & UsdRws).Value
      Sheets("Sheet1").Range("A30").Resize(UsdRws - 1).Value = .Range("I2:I" & UsdRws).Value
   End With
End Sub
Click to expand...

Thanks for the help. Unfortunately i'm getting a Run-Time error '1004'.
When i run the debugger it highlights this line of code:

Sheets("Sheet1").Range("A30").Resize(UsdRws - 1).Value = .Range("I2:I" & UsdRws).Value

I appreciate the help.
 
Upvote 0
What was the error message?
 
Upvote 0
Fluff said:
What was the error message?
Click to expand...

Error is:
Run-time error '1004':
Application-defined or object-defined error.

When i hit debug, it takes me to this line of code:
Sheets("Sheet1").Range("A30").Resize(UsdRws - 1).value = .Range("I2:I" & UsdRws).value

Thank you!
 
Upvote 0
Looks like I missed a . on the UsdRws line, it should be
Code: 
Sub Cranman()
   Dim UsdRws As Long
   With Sheets("fitment")
      UsdRws = [COLOR=#ff0000].[/COLOR]Range("G" & Rows.Count).End(xlUp).Row
      .Range("I2:I" & UsdRws).Value = Range("G2:G" & UsdRws).Value
      Sheets("Sheet1").Range("A30").Resize(UsdRws - 1).Value = .Range("I2:I" & UsdRws).Value
   End With
End Sub
 
Upvote 0
Hello,

Thanks for the help, it is still giving me the same error as before.
I've included the all of the code for this project. Maybe it will help having it all.

Code: 
Sub ProForm1()
'
' ProForm1 Macro
'
'Define Worksheets
Dim pf As Worksheet
Set pf = Worksheets("ProForm")
Dim sh1 As Worksheet
Set sh1 = Worksheets("Sheet1")
Dim d As Worksheet
Set d = Worksheets("Dimensions")
Dim ft As Worksheet
Set ft = Worksheets("Fitment")




'Run Concat Formula
    ft.Select
    Columns(7).Select
    Selection.Value = Selection.FormulaR1C1
    
'Copy Concat Value and Paste
    ft.Select
    Columns(7).Select
    Selection.Copy
    ft.Select
    Columns(9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
        


'Copy and Paste Part Number, MAP, UPC headers
    pf.Select
    Range("C1:E1").Select
    Selection.Copy
    sh1.Select
    Range("A6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    sh1.Columns("A").ColumnWidth = 11.57




'Cut and Paste Short Description
    pf.Select
    Range("B2").Select
    Selection.Cut
    sh1.Select
    Range("A5").Select
    ActiveSheet.Paste
    Selection.Font.Bold = True
    Selection.Font.Size = 14
    
'Copy and Paste Part Number, MAP, UPC Values
    pf.Select
    Range("C2:E2").Select
    Selection.Copy
    sh1.Select
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True


 'Copy and Projected Availability Header
    pf.Select
    Range("F1").Select
    Selection.Copy
    sh1.Select
    Range("A10").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    
        
 'Copy and Paste Projected Availability then Format to a Date
    pf.Select
    Range("F2").Select
    Selection.Copy
    sh1.Select
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Selection.Value = Selection.Value
    
 'Copy and Paste Box Dimension Header
    pf.Select
    Range("G1").Select
    Selection.Copy
    sh1.Select
    Range("A13").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    
    
 'Copy and Paste Length Width Height Headers
    pf.Select
    Range("H1:K1").Select
    Selection.Copy
    sh1.Select
    Range("A14").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    
 'Check to see if Box or Retail Dims exist
 'Copy Box dims if exist otherwise Retail Dims
   Dim dimension As String
   dimension = d.Range("B2").Value
   
   
   If dimension = "0" Or dimension = "0.000" Then
    d.Select
    Range("E2:G2").Select
    Selection.Copy
    sh1.Select
    Range("B14").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
  Else
    d.Select
    Range("B2:D2").Select
    Selection.Copy
    sh1.Select
    Range("B14").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
   
   End If
   
'Copy and Paste Weight Value
    d.Select
    Range("H2").Select
    Selection.Copy
    sh1.Select
    Range("B17").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    
'Copy and Paste Installation Header
    pf.Select
    Range("L1").Select
    Selection.Copy
    sh1.Select
    Range("A19").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    
'Copy and Paste Time, Drilling, Visiblity, Codes Headers
    pf.Select
    Range("M1:P1").Select
    Selection.Copy
    sh1.Select
    Range("A20").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    
    
'Copy and Paste Time, Drilling, Visiblity, Codes Values
    pf.Select
    Range("M2:P2").Select
    Selection.Copy
    sh1.Select
    Range("B20").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    
'Copy and Paste Description Header
    pf.Select
    Range("R1").Select
    Selection.Copy
    sh1.Select
    Range("A25").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    
'Copy and Paste Bullets
    pf.Select
    Range("S2:T2").Select
    Selection.Copy
    sh1.Select
    Range("A26").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True


'Copy and Vehicle Application Header
    pf.Select
    Range("U1").Select
    Selection.Copy
    sh1.Select
    Range("A29").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    
'Insert Pic


    Dim profile As String
    On Error GoTo 0
    Dim fd As FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        .Title = "Choose Photo"
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    sh1.Range("F6").Select
    
    sh1.Shapes.AddPicture Filename:=fd.SelectedItems(1), _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoCTrue, _
    Left:=ActiveSheet.Range("F6").Left, _
    Top:=ActiveSheet.Range("F6").Top, _
    Width:=238, _
    Height:=238
    
'copy app data
   Dim UsdRws As Long
   With Sheets("fitment")
      UsdRws = .Range("G" & Rows.Count).End(xlUp).Row
      .Range("I2:I" & UsdRws).Value = Range("G2:G" & UsdRws).Value
      Sheets("Sheet1").Range("A30").Resize(UsdRws - 1).Value = .Range("I2:I" & UsdRws).Value
   End With
    
    
'Delete Worksheets
    Worksheets("ProForm").Delete
    Worksheets("Dimensions").Delete
    
'Rename Sheet 1
    sh1.Name = "Pro Form"
 
End Sub

Thank you
 
Last edited by a moderator:
Upvote 0
Missed another one of these .
Code: 
   With Sheets("fitment")
      UsdRws = .Range("G" & Rows.Count).End(xlUp).Row
      .Range("I2:I" & UsdRws).Value = [COLOR=#ff0000].[/COLOR]Range("G2:G" & UsdRws).Value
      Sheets("Sheet1").Range("A30").Resize(UsdRws - 1).Value = .Range("I2:I" & UsdRws).Value
   End With
but that should not cause the error you're getting.
 
Upvote 0
I added the missing .

Error still occurs pointing to the same line of code it has been:

Sheets("Sheet1").Range("A30").Resize(UsdRws - 1).Value = .Range("I2:I" & UsdRws).Value
 
Upvote 0
What is the value of UsdRws when you get the error?
Also does it copy all the data from col G to col I?
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Paste the data in row 10
Replies
2
Views
222
sofas
S
S
  • Question
Copy a column value when the values match to multiple sheets of the workbook
Replies
1
Views
227
sofas
S
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
187
Insurance Dave
I
tabbytomo
  • Solved
Copy entire row if cell has specific value, looking at multiple columns and worksheets.
Replies
2
Views
271
NateSC
NateSC
P
  • Question
Data not copying fully into ListBox2
Replies
0
Views
79
Patriot2879
P

Forum statistics

Threads
1,214,412
Messages
6,119,365
Members
448,888
Latest member
Arle8907

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