PDA

View Full Version : auto transfer multiple rows from one excel to another



sai0449
12-04-2015, 11:28 AM
need to auto transfer specific multiple rows from one excel to another excel file into specific rows of the same fields

attached two files plz transfer blank colums automaticaly from other file using button option

Leith Ross
12-05-2015, 10:12 PM
Hello sai0449,

Will you always have the same number of rows filled with data in each workbook's table?

Will both tables have the same column headers?

If the answer to both questions above is yes then this macro should work for you. This macro assumes only 2 workbooks will open. The macro enabled workbook and an XLSX workbook which will receive the data. If your files are protected then macro will need to be modified to remove and restore worksheet protection or it will not run.

The name of the source and destination worksheets are set to "Sheet1". Change these if you need to. A button has been add to the source worksheet to run the macro.



Sub CopyData()

Dim ColArray As Variant
Dim DstRng As Range
Dim DstWkb As Workbook
Dim DstWks As Worksheet
Dim n As Long
Dim SrcRng As Range
Dim SrcWkb As Workbook
Dim SrcWks As Worksheet

For n = 1 To 2
Select Case Workbooks(n).Name
Case Is = ThisWorkbook.Name
Set SrcWkb = Workbooks(n)
Set SrcWks = SrcWkb.Worksheets("Sheet1")
Set SrcRng = SrcWks.Range("A1").CurrentRegion
Case Else
Set DstWkb = Workbooks(n)
Set DstWks = DstWkb.Worksheets("Sheet1")
Set DstRng = DstWks.Range("A1").CurrentRegion
End Select
Next n

ColArray = Array(3, 4, 5, 7, 10, 11, 12, 13, 14, 15, 16, 17, 20)

For n = 0 To UBound(ColArray)
DstRng.Columns(ColArray(n)).Value = SrcRng.Columns(ColArray(n)).Value
Next n

End Sub