So, i need to copy information from specific columns of one workbook and paste this information in specific columns of another workbook. I have done this successfully by writing the following code:
Sub test()
Dim wb As Workbook
Dim mysh As Worksheet
Dim sourceColumn As Range
Dim targetColumn As Range
Dim i As Long
Set wb = Workbooks("WorkbookA.xlsm")
'Above code is same as yours
Set mysh = wb.Sheets(1) 'if only one sheet, use loop otherwise
mysh.Range("J1").AutoFilter Field:=10, Criteria1:=">=" & Date
Application.ScreenUpdating = False
Set sourceColumn = Workbooks("WorkbookA.xlsm").Worksheets(1).Columns("D")
Set targetColumn = Workbooks("WorkbookB.xlsm").Worksheets(1).Columns("B")
sourceColumn.Copy Destination:=targetColumn
Set sourceColumn = Workbooks("WorkbookA.xlsm").Worksheets(1).Columns("C")
Set targetColumn = Workbooks("WorkbookB.xlsm").Worksheets(1).Columns("C")
sourceColumn.Copy Destination:=targetColumn
Set sourceColumn = Workbooks("WorkbookA.xlsm").Worksheets(1).Columns("G")
Set targetColumn = Workbooks("WorkbookB.xlsm").Worksheets(1).Columns("D")
sourceColumn.Copy Destination:=targetColumn
Set sourceColumn = Workbooks("WorkbookA.xlsm").Worksheets(1).Columns("J")
Set targetColumn = Workbooks("WorkbookB.xlsm").Worksheets(1).Columns("E")
sourceColumn.Copy Destination:=targetColumn
Set sourceColumn = Workbooks("WorkbookA.xlsm").Worksheets(1).Columns("K")
Set targetColumn = Workbooks("WorkbookB.xlsm").Worksheets(1).Columns("F")
sourceColumn.Copy Destination:=targetColumn
Set sourceColumn = Workbooks("WorkbookA.xlsm").Worksheets(1).Columns("L")
Set targetColumn = Workbooks("WorkbookB.xlsm").Worksheets(1).Columns("G")
sourceColumn.Copy Destination:=targetColumn
Application.ScreenUpdating = True
End Sub
What i specifically want to do is to copy and paste this information from only the first 6 visible records of WorkbookA.These records are not from ( cell numbers 1 to 6)
At the moment information from all rows are getting copied and pasted.
How do i modify the code in an appropriate manner to perform this correctly?
Instead of the columns
use range
to define the number of cells that you want to copy.
Set sourceColumn = Workbooks("WorkbookA.xlsm").Worksheets(1).Range("D1:D6")
Set targetColumn = Workbooks("WorkbookB.xlsm").Worksheets(1).Range("B1:B6")
sourceColumn.Copy Destination:=targetColumn
Using Columns
is not recommend because it's a time-consuming task for VBA. A single column can be a collection +1M cells. That will take Excel a lot of time to process.
sourceColumn
and targetColumn
need to be defined as range
Edit 1: Now that you have filtering according to your comments, you might want to try this:
Define a variable to get the last row number of data from the sourcecolumn. Something like for column D:
Dim LastRow as Long
With Workbooks("WorkbookA.xlsm").Worksheets(1)
LastRow = .Cells(.Rows.count, "D").End(XlUp).Row
End With
Now we're going to get the range of the visible cells from the source column. This the step that will just the visible cells after you apply the filter.( I've excluded D1 because it should be the header of your column )
Set sourceColumn = Workbooks("WorkbookA.xlsm").Worksheets(1).Range("D2:D" & lastrow).SpecialCells(xlCellTypeVisible)
We'll simply run through the cell collection of sourcecolumn and tell to paste it just 6 cells in the target workbook:
Dim counter as integer: counter = 1
With Workbooks("WorkbookB.xlsm").Worksheets(1)
For each cell in sourcecolumn
if counter = 7 then
Exit for
end if
.Range("B" & counter) = cell.value
counter = counter + 1
Next
End With
'Counter = 0 do forget to reset it if you're going to use it for the other columns
Tested and working :)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.