Pasting Error when copying columns

[Holley]

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:

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

 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

 

[Vogateer]

The code you have is trying to select the contiguous cells below the Selection:

Range(Selection, Selection.End(xlDown)).Select

That .End(xlDown) is the part that's trying to select contiguous cells below the selection point, and I'm guessing that's what's selecting the whole column. If you only want the cells that contain data, you might have better luck finding the last cell in that column with data, and then explicitly copying that range.

I think the easiest way in this case is to do the following, avoiding selecting altogether for the copy function:

Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
Range(Cells(2,1), Cells(LastRow,3)).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

 

[Holley]

The code you have is trying to select the contiguous cells below the Selection:

Range(Selection, Selection.End(xlDown)).Select

That .End(xlDown) is the part that's trying to select contiguous cells below the selection point, and I'm guessing that's what's selecting the whole column. If you only want the cells that contain data, you might have better luck finding the last cell in that column with data, and then explicitly copying that range.

I think the easiest way in this case is to do the following, avoiding selecting altogether for the copy function:

Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
Range(Cells(2,1), Cells(LastRow,3)).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

Thanks! I truly appreciate the super fast reply, but it only copied cells A1:C2. I need to copy all the date starting on row 2 in columns A-C. he number of rows will vary daily so I cannot put in a specific range.

 

[Vogateer]

Hmm, maybe my made up data doesn't match yours. Could you post a screenshot of the sheet that you're copying from? Is Column C empty or something like that?

 

[Holley]

Hmm, maybe my made up data doesn't match yours. Could you post a screenshot of the sheet that you're copying from? Is Column C empty or something like that?

It could potentially contain 200+ rows

 

[Vogateer]

That's weird, because when I run the code it selects all the rows.

Copy Sheet

Paste Sheet

Maybe we should try to be explicit in our references and see if there's some confusion about what the ActiveSheet is. Is this VBA running from the workbook you're copying from? If so, could you give me the name of the sheet we're copying from, or the index number for the sheet we're copying from?

 

[Holley]

That's weird, because when I run the code it selects all the rows.

Copy Sheet
View attachment 114042

Paste Sheet
View attachment 114043

Maybe we should try to be explicit in our references and see if there's some confusion about what the ActiveSheet is. Is this VBA running from the workbook you're copying from? If so, could you give me the name of the sheet we're copying from, or the index number for the sheet we're copying from?

no, it is in my personal.xlbm and I am running from there. It actually prompts you to open a file, import the data from a text file, delete what isn't needed, run a query to select the necessary text, thats when it copies and paste into the other file.

 

[Vogateer]

Can you show the part of the code for selecting the file and how we know which sheet we need to copy from?

I think if we assign the workbook and worksheet to variables, we can make sure there's no weird reference issues. I'm not sure how much of your code you can show, but I basically want to Dim a Workbook and a Worksheet, and then assign the selected file you're opening to that Workbook variable, select the correct Worksheet (is there always only one worksheet?), and then make sure that object is available for the rest of the code we're running.

 

[Holley]

Can you show the part of the code for selecting the file and how we know which sheet we need to copy from?

I think if we assign the workbook and worksheet to variables, we can make sure there's no weird reference issues. I'm not sure how much of your code you can show, but I basically want to Dim a Workbook and a Worksheet, and then assign the selected file you're opening to that Workbook variable, select the correct Worksheet (is there always only one worksheet?), and then make sure that object is available for the rest of the code we're running.

This is the whole code with your above edit under "Copy and Paste into new sheet"

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
  '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
ActiveSheet.Name = "Sheet1"
Columns("D").EntireColumn.Delete Columns("A:C").Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$C"), , xlNo).Name = "Table1"
    Columns("A:C").Select
   
'Create Query
      Columns("A:C").Select
    ActiveWorkbook.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"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.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"
         ActiveWorkbook.RefreshAll
    End With
    
   
   ' Copy and Paste_into_new_sheet
   
Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
Range(Cells(2,1), Cells(LastRow,3)).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
  
End Sub

 

[Vogateer]

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.

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