Copy and Paste a dynamic range between two workbooks

Question

I am trying to copy and paste data found in one workbook to another. I am having difficulties copying the data and I am not too sure if it is the looping through the row data, which is causing the issues:

Sub essaie()

    Dim x As Workbook
    Dim y As Workbook
    Dim xlastcol As Integer 'variable for the last row
    Dim xcol As Variant 'variable first row
    Dim Headers() As Variant
    Dim h As Variant
    Dim ws As Worksheet
    Dim xrow As Integer
    Dim xlastrow As Variant

    Set y = Workbooks("VBAGOOD.xlsx")
    Set x = Workbooks("Aubaine.xlsm")

    Headers() = Array("net", "date", "description")

    y.Worksheets("try").Activate

    Set ws = y.Worksheets("try")

    xcol = 1 
    xlastcol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column

    xrow = 2
    xlastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Do Until xcol = xlastcol 'loop through a range of data
    Do Until xrow = xlastrow

        For Each h In Headers
            If h = ws.Cells(xcol, xlastcol).Value Then
                ws.Activate
                ws.Cells(xrow, xlastrow).Select
                Selection.Copy
                x.Activate
                x.Worksheets("test").Range("a1:a65").PasteSpecial
           End If  
        Next h

    Loop
    Loop

End Sub

The data I am trying to copy is below three columns.

date      address     comments 

123       udhsdh      gguu

124       udhsdh      gguu

125       udhsdh      sdg

Answer 1

I haven't run your code but unless I'm missing something, your Do loops are either not executed or result in infinite loops (since you don't appear to change the values of xcol and xrow inside the respective loops).

Inside the loop, you appear to paste to the same range ( A1:A65 ) repeatedly -- which means each iteration overwrites the previous iteration's results. Seems like you were just testing (to see if the loop works) and were then going to change the range to which you paste.

If I've understood correctly:

• copy "data" from worksheet A and paste to worksheet B
• worksheet A and worksheet B are in different workbooks
• only copy columns with headers: net , date , description (although your question says: date , address , comments )
• last row can be detected using column A (as per your code).

Maybe the code below can give you some idea on how to achieve what you want:

Option Explicit

Private Function GetHeaderColumnIndexes(ByVal someSheet As Worksheet, ParamArray headersToSearchFor() As Variant) As Long()
    Const HEADER_ROW_INDEX As Long = 1 ' I assume row 1, change as neccessary.

    Dim outputArray() As Long
    ReDim outputArray(LBound(headersToSearchFor) To UBound(headersToSearchFor))

    Dim i As Long
    Dim matchResult As Variant
    For i = LBound(headersToSearchFor) To UBound(headersToSearchFor)
        matchResult = Application.Match(headersToSearchFor(i), someSheet.Rows(HEADER_ROW_INDEX), 0)

        Debug.Assert IsNumeric(matchResult) ' Should probably raise an error instead.
        outputArray(i) = matchResult
    Next i
    GetHeaderColumnIndexes = outputArray
End Function

Private Sub TransferDataAcrossWorkbooks()

    Dim sourceSheet As Worksheet
    Set sourceSheet = Workbooks("VBAGOOD.xlsx").Worksheets("try") ' Change as necessary

    Dim lastSourceRow As Long
    lastSourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

    Dim destinationSheet As Worksheet
    Set destinationSheet = Workbooks("Aubaine.xlsm").Worksheets("test") ' Change as necessary

    Dim targetColumnIndexes() As Long
    targetColumnIndexes = GetHeaderColumnIndexes(sourceSheet, "net", "date", "description")

    Dim columnIndex As Variant
    For Each columnIndex In targetColumnIndexes ' Would be better to use For loop instead of For each
        Dim rangeToCopy As Range
        Set rangeToCopy = Intersect(sourceSheet.Range("1:" & lastSourceRow), sourceSheet.Columns(columnIndex))

        Dim destinationColumnIndex As Long
        destinationColumnIndex = destinationColumnIndex + 1

        Dim rangeToPasteTo As Range
        Set rangeToPasteTo = destinationSheet.Cells(1, destinationColumnIndex)

        rangeToCopy.Copy rangeToPasteTo
    Next columnIndex

End Sub

• Since you weren't providing any arguments to Range.PasteSpecial in your code, the defaults were being used, which I think is equivalent to a regular paste.
• If you want to change this behaviour (eg paste only values), you can re-introduce Range.PasteSpecial and provide appropriate arguments.