Pasting Error when copying columns

H

Holley

Board Regular
Joined
Dec 11, 2019
Messages
155
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hello All! In my code, once I have created a query, I need to copy only the rows containing data in columns A-C. When using the code:
VBA Code: 
Range(Selection, Selection.End(xlDown)).Select
it appears all is well when checking with F8, but when running the whole code, the entire column is selecting causing a Run-Time error '1004' You can't paste this here because the copy area and paste area aren't the same size... I cannot figure out why it is selecting the entire column instead of just the rows that contain data. Any assistance would be most appreciated! This is the whole code I am using
VBA Code: 
 Range("A2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.copy
     Workbooks.Open fileName:= _
        "https://company-my.sharepoint.com/personal/myname_company_com/Documents/Desktop/file2.xlsm"
    Windows("file2.xlsm").Activate
    Range("A5").Select
    ActiveSheet.paste
 
Sort by date Sort by votes
Vogateer said:
I can't really test all this code since I don't have the *.lin files (post a dummy file here if you want me to test it), but the main idea is to get rid of the ActiveSheet or ActiveWorkbooks, so there's no doubt about which sheet the code is running on. I've added workbook and worksheet variables, and I think that might help avoid some weird issue where you think you're working on one sheet but Excel is actually working on another. I'm not sure this will work, but I think it's good practice to explicitly name and reference workbooks and sheets, so I doubt it will hurt anything.

Definitely back up everything before running this, because I can see some deletions going on, and you want to make sure that's handled correctly.

VBA Code: 
Sub codes()

    ' Select File
    Dim myfile As Variant
    myfile = Application.GetOpenFilename( _
                                          FileFilter:="Text Files (*.lin), *.lin", _
                                          Title:="Select text file", _
                                          ButtonText:="Open")
    If myfile = False Then Exit Sub
    Dim my_workbook As Workbook, my_worksheet As Worksheet
    Set my_workbook = Workbooks.Add
    ' First digit in array is character and 2nd is format.
    my_workbook.OpenText Filename:=myfile, _
        Origin:=437, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 2), Array(9, 2), Array(13, 2), Array(18, 2)) _
        , TrailingMinusNumbers:=True
    Set my_worksheet = my_workbook.Sheets("Sheet1")
 
    With my_worksheet
        .Columns("D").EntireColumn.Delete Columns("A:C").Select
        Application.CutCopyMode = False
        .ListObjects.Add(xlSrcRange, Range("$A:$C"), , xlNo).Name = "Table1"
 
        ' Create Query
        .Columns("A:C").Select
        Selection.Queries.Add Name:="Table1", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.CurrentWorkbook(){[Name=""Table1""]}[Content]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}})," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows"" = Table.SelectRows(#""Changed Type"", each [Column2] <> null and [Column2] <> """")," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows1"" = Table.SelectRows(#""F" & _
        "iltered Rows"", each not Text.StartsWith([Column2], ""8""))," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows2"" = Table.SelectRows(#""Filtered Rows1"", each ([Column2] <> ""-05"" and [Column2] <> ""H IN"" and [Column2] <> ""NBR""))" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Filtered Rows2"""
    End With
   
    Dim second_sheet As Worksheet
    Set second_sheet = my_workbook.Worksheets.Add
 
    With second_sheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Table1;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table1]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table1_2"
         my_workbook.RefreshAll
    End With
 
   ' Copy and Paste_into_new_sheet
    Dim LastRow As Long, CopyRange As Range
    Dim PasteWorkbook As Workbook, PasteSheet As Worksheet, PasteRange As Range
    LastRow = second_sheet.Cells(second_sheet.Rows.Count, "C").End(xlUp).Row
    Set CopyRange = second_sheet.Range(Cells(2, 1), Cells(LastRow, 3))
    Set PasteWorkbook = Workbooks.Open(Filename:= _
        "https://company-my.sharepoint.com/personal/myname_company_com/Documents/Desktop/file2.xlsm")
    Set PasteSheet = PasteWorkbook.Sheets(1) ' YOU MIGHT NEED TO CHANGE THIS
    CopyRange.Copy Destination:=PasteSheet.Range("A5")
 
End Sub
[/
[/QUOTE]
Click to expand...
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Thanks... i get a run time 438 error here: Object doesn't support this property or method


1720809694392.png
 
Upvote 0
Whoops, it looks like Workbooks.OpenText doesn't return the workbook object. Looks like we'll have to use the ActiveWorkbook at least once, then, but it's short-lived:

VBA Code: 
Sub codes()

    ' Select File
    Dim myfile As Variant
    myfile = Application.GetOpenFilename( _
                                          FileFilter:="Text Files (*.lin), *.lin", _
                                          Title:="Select text file", _
                                          ButtonText:="Open")
    If myfile = False Then Exit Sub
    Dim my_workbook As Workbook, my_worksheet As Worksheet
    ' First digit in array is character and 2nd is format.
    Workbooks.OpenText Filename:=myfile, _
        Origin:=437, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 2), Array(9, 2), Array(13, 2), Array(18, 2)) _
        , TrailingMinusNumbers:=True
    Set my_workbook = ActiveWorkbook
    Set my_worksheet = my_workbook.Sheets("Sheet1")
 
    With my_worksheet
        .Columns("D").EntireColumn.Delete
        .Columns("A:C").Select
        Application.CutCopyMode = False
        .ListObjects.Add(xlSrcRange, .Range("$A:$C"), , xlNo).Name = "Table1"
 
        ' Create Query
        .Columns("A:C").Select
        Selection.Queries.Add Name:="Table1", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.CurrentWorkbook(){[Name=""Table1""]}[Content]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}})," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows"" = Table.SelectRows(#""Changed Type"", each [Column2] <> null and [Column2] <> """")," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows1"" = Table.SelectRows(#""F" & _
        "iltered Rows"", each not Text.StartsWith([Column2], ""8""))," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows2"" = Table.SelectRows(#""Filtered Rows1"", each ([Column2] <> ""-05"" and [Column2] <> ""H IN"" and [Column2] <> ""NBR""))" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Filtered Rows2"""
    End With
    
    Dim second_sheet As Worksheet
    Set second_sheet = my_workbook.Worksheets.Add
 
    With second_sheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Table1;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table1]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table1_2"
         my_workbook.RefreshAll
    End With
 
   ' Copy and Paste_into_new_sheet
    Dim LastRow As Long, CopyRange As Range
    Dim PasteWorkbook As Workbook, PasteSheet As Worksheet, PasteRange As Range
    LastRow = second_sheet.Cells(second_sheet.Rows.Count, "C").End(xlUp).Row
    Set CopyRange = second_sheet.Range(.Cells(2, 1), .Cells(LastRow, 3))
    Set PasteWorkbook = Workbooks.Open(Filename:= _
        "https://company-my.sharepoint.com/personal/myname_company_com/Documents/Desktop/file2.xlsm")
    Set PasteSheet = PasteWorkbook.Sheets(1) ' YOU MIGHT NEED TO CHANGE THIS
    CopyRange.Copy Destination:=PasteSheet.Range("A5")
 
End Sub

I had to make a few changes, adding some dots where I forgot them earlier (e.g., .Cells)
 
Last edited:
Upvote 0
Vogateer said:
Whoops, it looks like Workbooks.OpenText doesn't return the workbook object. Looks like we'll have to use the ActiveWorkbook at least once, then, but it's short-lived:

VBA Code: 
Sub codes()

    ' Select File
    Dim myfile As Variant
    myfile = Application.GetOpenFilename( _
                                          FileFilter:="Text Files (*.lin), *.lin", _
                                          Title:="Select text file", _
                                          ButtonText:="Open")
    If myfile = False Then Exit Sub
    Dim my_workbook As Workbook, my_worksheet As Worksheet
    ' First digit in array is character and 2nd is format.
    Workbooks.OpenText Filename:=myfile, _
        Origin:=437, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 2), Array(9, 2), Array(13, 2), Array(18, 2)) _
        , TrailingMinusNumbers:=True
    Set my_workbook = ActiveWorkbook
    Set my_worksheet = my_workbook.Sheets("Sheet1")
 
    With my_worksheet
        .Columns("D").EntireColumn.Delete
        .Columns("A:C").Select
        Application.CutCopyMode = False
        .ListObjects.Add(xlSrcRange, .Range("$A:$C"), , xlNo).Name = "Table1"
 
        ' Create Query
        .Columns("A:C").Select
        Selection.Queries.Add Name:="Table1", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.CurrentWorkbook(){[Name=""Table1""]}[Content]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}})," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows"" = Table.SelectRows(#""Changed Type"", each [Column2] <> null and [Column2] <> """")," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows1"" = Table.SelectRows(#""F" & _
        "iltered Rows"", each not Text.StartsWith([Column2], ""8""))," & Chr(13) & "" & Chr(10) & "    #""Filtered Rows2"" = Table.SelectRows(#""Filtered Rows1"", each ([Column2] <> ""-05"" and [Column2] <> ""H IN"" and [Column2] <> ""NBR""))" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Filtered Rows2"""
    End With
   
    Dim second_sheet As Worksheet
    Set second_sheet = my_workbook.Worksheets.Add
 
    With second_sheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Table1;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table1]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table1_2"
         my_workbook.RefreshAll
    End With
 
   ' Copy and Paste_into_new_sheet
    Dim LastRow As Long, CopyRange As Range
    Dim PasteWorkbook As Workbook, PasteSheet As Worksheet, PasteRange As Range
    LastRow = second_sheet.Cells(second_sheet.Rows.Count, "C").End(xlUp).Row
    Set CopyRange = second_sheet.Range(.Cells(2, 1), .Cells(LastRow, 3))
    Set PasteWorkbook = Workbooks.Open(Filename:= _
        "https://company-my.sharepoint.com/personal/myname_company_com/Documents/Desktop/file2.xlsm")
    Set PasteSheet = PasteWorkbook.Sheets(1) ' YOU MIGHT NEED TO CHANGE THIS
    CopyRange.Copy Destination:=PasteSheet.Range("A5")
 
End Sub

I had to make a few changes, adding some dots where I forgot them earlier (e.g., .Cells)
Click to expand...
It runs, just still only copies rows 1 and 2 of the initial worksheet :(
 
Upvote 0
Can you give me an example file that's being opened, or just a few lines that I can save into a file? It's just hard for me to guess how it's only selecting the first 2 rows when the first thing I tell it to do with the copy range is start from the second row.
 
Upvote 0
Vogateer said:
Can you give me an example file that's being opened, or just a few lines that I can save into a file? It's just hard for me to guess how it's only selecting the first 2 rows when the first thing I tell it to do with the copy range is start from the second row.
Click to expand...
let me see if I can dummy up some data... it will be a bit, thank you so very much for your help!
 
Upvote 0
Holley said:
let me see if I can dummy up some data... it will be a bit, thank you so very much for your help!
Click to expand...
Sounds good. Do you know how to step through the VBA scripts with F8 and put the mouse cursor over the variables to see what their values are? That might help us, too, especially at that line where it's assigning a value to the CopyRange. If not, I can place some MsgBoxs in the code and have it give us some info.
 
Upvote 0
Vogateer said:
Sounds good. Do you know how to step through the VBA scripts with F8 and put the mouse cursor over the variables to see what their values are? That might help us, too, especially at that line where it's assigning a value to the CopyRange. If not, I can place some MsgBoxs in the code and have it give us some info.
Click to expand...
Im familiar with f8, but thats about it. I wasn't aware you could put the mouse over...
 
Upvote 0
Holley said:
Im familiar with f8, but thats about it. I wasn't aware you could put the mouse over...
Click to expand...
Yes, if you hit F8 and then stop just as it highlights the "CopyRange =" line, you should be able to mouse over the "LastRow" value and see what it has for that value. You could also type another line below CopyRange that's something like this:
VBA Code: 
MsgBox "CopyRange is " & CopyRange.Address
' or for the immediate window
Debug.Print "CopyRange is " & CopyRange.Address

And that will pop up with a MsgBox that shows the Address for the range it's copying.
 
Upvote 0
Vogateer said:
Yes, if you hit F8 and then stop just as it highlights the "CopyRange =" line, you should be able to mouse over the "LastRow" value and see what it has for that value. You could also type another line below CopyRange that's something like this:
VBA Code: 
MsgBox "CopyRange is " & CopyRange.Address
' or for the immediate window
Debug.Print "CopyRange is " & CopyRange.Address

And that will pop up with a MsgBox that shows the Address for the range it's copying.
Click to expand...
awesome! This is the result
1720816580670.png
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Copy hidden row and paste unhidden after last row
Replies
6
Views
112
Peter_SSs
Peter_SSs
E
  • Solved
macro for copying values to the next blank cell
Replies
5
Views
462
Micron
M
J
  • Question Question
VBA or formula to move data in last used column to column A
Replies
5
Views
227
Peter_SSs
Peter_SSs
R
  • Solved
Retype Macro to run properly
2
Replies
11
Views
144
Alex Blakenburg
A
C
  • Question Question
Find a column header, then copy and paste the column to a different location
Replies
7
Views
152
abdelfattah
A

Forum statistics

Threads
1,224,813
Messages
6,181,117
Members
453,021
Latest member
Justyna P

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