Clash Royale CLAN TAG#URR8PPP

Beginner Excel VBA with copy paste values issue

I have an exported data from a software that has like 80 or so columns of data. I don't need all the data, just 21 columns.

In my output, I would like the 21 columns to be in a particular order. So for example, I want the value from the cell AX2 from my source file to go to A2, BW2 to go to B2, etc. in the output.

The source data may differ from month to month and could have as little as 1 row of data or hundreds so I would like this to loop until no data is left.

I tried to write a code but I am running into issues. I got a run time error 424 object required. Note: I have only outlined the rules for two columns but will work on the rest when I get the proper set up :

Sub Macro1()
'
' Macro1 Macro
'

'
Sheet4.Select
Application.ScreenUpdating = False

row_count = 2

Do While Sheet2.Range("A" & row_count) <> ""

Range("AX2:AX1000").Select
Selection.Copy

ActiveWindow.ActivateNext
Range("A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveWindow.ActivateNext
Range("BW2:BW1000").Select
Application.CutCopyMode = False
Selection.Copy

ActiveWindow.ActivateNext
Range("B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

x = x + 1

ActiveWindow.ActivateNext
ActiveSheet.Next.Select

ActiveSheet.Next.Select


Loop


End Sub


2 Answers
2

I hope I didn't go too far. Try this subscript, it asks you to select a workbook, it will open the workbook, copy column B2 to last used Row on Column B, and paste it on the first workbook. Make sure to rename the CopyFromSheet and CopyToSheet on the code. Please read each line and try to understand what it is doing. Let me know if any questions.

Sub CopyPaste()
Dim openFile As FileDialog, wb As Workbook, sourceWb As Workbook
Dim CopyTo As String, CopyFrom As String
Dim lastRow As Long
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set openFile = Application.FileDialog(msoFileDialogFilePicker)
openFile.Title = "Select Source File"
openFile.Filters.Clear
openFile.Filters.Add "Excel Files Only", "*.xl*"
openFile.Filters.Add "All Files", "*.*"
openFile.Show
If openFile.SelectedItems.Count <> 0 Then
Set sourceWb = Workbooks.Open(openFile.SelectedItems(1), False, True, , , , True)
CopyFrom = "CopyFromSheetName"
CopyTo = "CopyToSheetName"
lastRow = sourceWb.Sheets(CopyFrom).Cells(Rows.Count, "B").End(Excel.xlUp).Row
sourceWb.Sheets(CopyFrom).Range("B2:B" & lastRow).Copy 'You can copy this Row and the Next and add as many as you want to copy the Columns Needed
wb.Sheets(CopyTo).Range("B1").PasteSpecial xlValues
Application.CutCopyMode = xlCopy
Else
MsgBox "A file was not selected"
End If
Application.ScreenUpdating = True
End Sub


I suggest you separate the copy logic from the setup of which columns to copy. That way it will be much easier to manage the setup.

In this code I have hard coded to Columns Pairs. Alternatively, you could put that data on a sheet and read it in.

Sub Demo()
'declare all your variables
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim rSource As Range
Dim rDest As Range
Dim CP() As Variant 'Column Pairs array
Dim idx As Long

'Set up an array of Source and Destination columns
ReDim CP(1 To 21, 1 To 2) 'Adjust size to suit number of column pairs
CP(1, 1) = "AX": CP(1, 2) = "A"
CP(2, 1) = "BW": CP(2, 2) = "B"
'and so on

' Source and Destination don't have to be in the same Workbook
' This code assumes the Source (and Destination) worksbooks are already open
' You can add code to open them if required
' If the data is in the same book as the code, use ThisWorkbook
' If the data is in a different book from the code,
' specify the book like Application.Workbooks("BookName.xlsx")
' or use ActiveWorkbook

'Update the names to your sheet names
Set wsSource = ThisWorkbook.Worksheets("SourceSheetName")
Set wsDest = ThisWorkbook.Worksheets("DestSheetName")


' Notice that form here on the code is independent of the Sheet and Column names
'Loop the column pairs array
For idx = 1 To UBound(CP, 1)
'if the entry is not blank
If CP(idx, 1) <> vbNullString Then
'Get reference to source column cell on row 2
Set rSource = wsSource.Columns(CP(idx, 1)).Cells(2, 1)
'If that cell is not empty
If Not IsEmpty(rSource) Then
'If the next cell is not empty
If Not IsEmpty(rSource.Offset(1, 0)) Then
'extend range down to first blank cell
Set rSource = wsSource.Range(rSource, rSource.End(xlDown))
End If
'Get a reference to the destination range, from row 2, same size as source
Set rDest = wsDest.Columns(CP(idx, 2)).Cells(2, 1).Resize(rSource.Rows.Count)

'Copy the values
rDest.Value = rSource.Value
End If
End If
Next
End Sub


By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.