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

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
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

E
  • Solved
macro for copying values to the next blank cell
Replies
5
Views
414
Micron
M
R
  • Solved
Retype Macro to run properly
2
Replies
11
Views
84
Alex Blakenburg
A
S
  • Question Question
Dynamic Address by VBA
Replies
8
Views
151
MikeVol
MikeVol
J
  • Question Question
VBA - Copy Data Range without giving exact location to another sheet
Replies
1
Views
210
Anthony47
A
S
  • Question Question
Vba to search for a value in column A, if found enter specific text then delete the row
Replies
2
Views
258
StevenChin
S

Forum statistics

Threads
1,223,884
Messages
6,175,175
Members
452,615
Latest member
bogeys2birdies

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