使用excel-vba宏将信息从前6行的特定列复制并粘贴到一个工作簿中

Question

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?

Answer 1

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 :)