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
Okay, so clearly the CopyRange isn't right, but I'm not sure how that's happening. Could you change that CopyRange to the following, and see if you get the same MsgBox value?
VBA Code: 
Set CopyRange = second_sheet.Range(second_sheet.Cells(2, 1), second_sheet.Cells(LastRow, 3))
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Vogateer said:
Okay, so clearly the CopyRange isn't right, but I'm not sure how that's happening. Could you change that CopyRange to the following, and see if you get the same MsgBox value?
VBA Code: 
Set CopyRange = second_sheet.Range(second_sheet.Cells(2, 1), second_sheet.Cells(LastRow, 3))
Click to expand...
Same result... I'm stumped
1720816949000.png
 
Upvote 0
Don't let me slow down your creation of that dummy data for me to test, but the last thing I can think of is to try to change the column we use for determining the last row, using the first column instead of the third column:

VBA Code: 
' Copy and Paste_into_new_sheet
    Dim LastRow As Long, CopyRange As Range
    Dim PasteWorkbook As Workbook, PasteSheet As Worksheet, PasteRange As Range
    ' Using the first column instead of the third with the '1' below
    LastRow = second_sheet.Cells(second_sheet.Rows.Count, 1).End(xlUp).Row
    Set CopyRange = second_sheet.Range(second_sheet.Cells(2, 1), _
                                       second_sheet.Cells(LastRow, 3))
    MsgBox "LastRow: " & LastRow & ", and CopyRange: " & CopyRange.Address
    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")
 
Upvote 0
I think it's the BackgroundQuery set to True that's causing problems. In my testing, the query was still running in the background while the rest of the script is running, so that it's copying and pasting before the query can place any data in the cells.

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(1)
  
    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
        .Parent.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:=second_sheet.Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table1]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False ' THIS IS WHAT I HAD TO CHANGE
        .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
    With second_sheet
        lastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        Set CopyRange = .Range(.Cells(2, 1), .Cells(lastRow, 3))
    End With
  
    MsgBox "LastRow: " & lastRow & ", and CopyRange: " & CopyRange.Address
    Set PasteWorkbook = Workbooks.Open(Filename:= _
        "https://company-my.sharepoint.com/personal/myname_company_com/Documents/Desktop/file2.xlsm")
    'Set PasteWorkbook = Workbooks.Add ' For testing
    Set PasteSheet = PasteWorkbook.Sheets(1) ' YOU MIGHT NEED TO CHANGE THIS
    CopyRange.Copy Destination:=PasteSheet.Range("A5")
 
End Sub
 
Upvote 0
Solution
Vogateer said:
Don't let me slow down your creation of that dummy data for me to test, but the last thing I can think of is to try to change the column we use for determining the last row, using the first column instead of the third column:

VBA Code: 
' Copy and Paste_into_new_sheet
    Dim LastRow As Long, CopyRange As Range
    Dim PasteWorkbook As Workbook, PasteSheet As Worksheet, PasteRange As Range
    ' Using the first column instead of the third with the '1' below
    LastRow = second_sheet.Cells(second_sheet.Rows.Count, 1).End(xlUp).Row
    Set CopyRange = second_sheet.Range(second_sheet.Cells(2, 1), _
                                       second_sheet.Cells(LastRow, 3))
    MsgBox "LastRow: " & LastRow & ", and CopyRange: " & CopyRange.Address
    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")
Click to expand...
I will have to try this on Monday when I'm back in the office. Unfortunately, I am unable to include real data - but this is a dummy file that I would end up... of course there will be anywhere from 50-200+ rows of data.
 
Upvote 0
Your revised code works like a charm! Many many thanks!!
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(1)
   
    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
        .Parent.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:=second_sheet.Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table1]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .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
    With second_sheet
        lastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        Set CopyRange = .Range(.Cells(2, 1), .Cells(lastRow, 3))
    End With
   
    MsgBox "LastRow: " & lastRow & ", and CopyRange: " & CopyRange.Address
    Set PasteWorkbook = Workbooks.Open(Filename:= _
        "https://company-my.sharepoint.com/personal/myname_company_com/Documents/Desktop/file2.xlsm")
    'Set PasteWorkbook = Workbooks.Add ' For testing
    Set PasteSheet = PasteWorkbook.Sheets(1) ' YOU MIGHT NEED TO CHANGE THIS
    CopyRange.Copy Destination:=PasteSheet.Range("A5")
 
End Sub
 
Upvote 0
Thank you! I'm glad we got it working, and thank you for bearing with me while we went through the troubleshooting process.
 
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
417
Micron
M
R
  • Solved
Retype Macro to run properly
2
Replies
11
Views
92
Alex Blakenburg
A
S
  • Question Question
Dynamic Address by VBA
Replies
8
Views
156
MikeVol
MikeVol
J
  • Question Question
VBA - Copy Data Range without giving exact location to another sheet
Replies
1
Views
211
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,952
Messages
6,175,592
Members
452,653
Latest member
craigje92

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