VBA Copy data from one sheet to another

Question

I'm pretty new to VBA and need some help with a project. I need to write a macro that reads the Sheet Name in Column C, and pastes the values from a source workbook to a range in a target workbook, which is specified in Column D.

So for example, it needs to copy the data in Sheet2 of Myworkbook book, and paste it into range of Theirworkbook Sheet2. The place where the range and sheet number information is stored in a separate workbook.

Edit: I've added a picture of what wbOpen looks like. This is it here.

Option Explicit

Sub PasteToTargetRange()

    Dim arrVar As Variant 'stores all the sheets to get the copied
    Dim arrVarTarget As Variant 'stores names of sheets in target workbook
    Dim rngRange As Range 'each sheet name in the given range
    Dim rngLoop As Range    'Range that rngRange is based in
    Dim wsSource As Worksheet 'source worksheet where ranges are found
    Dim wbSource As Workbook    'workbook with the information to paste
    Dim wbTarget As Workbook    'workbook that will receive information
    Dim strSourceFile As String 'location of source workbook
    Dim strTargetFile As String 'location of source workbook
    Dim wbOpen As Workbook  'Current open workbook(one with inputs)
    Dim wsRange As Range 'get information from source workbook
    Dim varRange As Range   'Range where values should be pasted
    Dim i As Integer 'counter for For Loop
    Dim wbkNewSheet As Worksheet 'create new worksheet if target workbook doesn't have
    Dim wsTarget As Worksheet 'target workbook worksheet
    Dim varNumber As String 'range to post
    
    
    
    Set wbOpen = Workbooks.Open("WorkbookWithRanges.xlsx")
    
    'Open source file
    MsgBox ("Open the source file")
    strSourceFile = Application.GetOpenFilename
       If strSourceFile = "" Then Exit Sub
       Set wbSource = Workbooks.Open(strSourceFile)
       
    'Open target file
    MsgBox ("Open the target file")
    strTargetFile = Application.GetOpenFilename
       If strTargetFile = "" Then Exit Sub
        Set wbTarget = Workbooks.Open(strTargetFile)
    
    'Activate transfer Workbook
    wbOpen.Activate
    

    Set wsRange = ActiveSheet.Range("C9:C20")
    
    Set arrVarTarget = wbTarget.Worksheets
    
        
    For Each varRange In wsRange
        If varRange.Value = 'Target workbook worksheets
            varNumber = varRange.Offset(0, -1).Value
            Set wsTarget = X.Offset(0, 1)
            
            wsSouce.Range(wsTarget).Value = varNumber
        Else
            wbkNewSheet = Worksheets.Add
            wbkNewSheet.Name = varRange.Value
      End If
    Next
        
    
End Sub

Where's the question or problem if your existing code. What does it do that it shouldn't ? — dbmitch
Set wbOpen = Workbooks.Open("WorkbookWithRanges.xlsx") - you should use the full path to the file here — Tim Williams
@dbmitch I'm really having problems with the if statement. I'm not sure how to have it check the the names of the worksheets in the target workbook against the names listed in "database" workbook. — Olu O.

Tim Williams Tim Williams · Accepted Answer · 2016-08-01T23:14:54

Something like this (untested but should give you an idea)

Sub PasteToTargetRange()

    '....omitted

    Set wsRange = wbOpen.Sheets(1).Range("C9:C20")

    For Each c In wsRange

        shtName = c.Offset(0, -1).Value
        Set wsTarget = GetSheet(wbTarget, shtName) 'get the target sheet

        wbSource.Sheets(shtName).Range(c.Value).Copy wsTarget.Range(c.Value)

    Next

End Sub

'Get a reference to a named sheet in a specific workbook
'  By default will create the sheet if not found 
Function GetSheet(wb As Workbook, ws As String, Optional CreateIfMissing As Boolean = True)
    Dim rv As Worksheet
    On Error Resume Next 'ignore eroror if no match
    Set rv = wb.Worksheets(ws)
    On Error GoTo 0 'stop ignoring errors
    'sheet wasn't found, and should create if missing
    If rv Is Nothing And CreateIfMissing Then
        Set rv = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
        rv.Name = ws
    End If
    Set GetSheet = rv
End Function

VBA Copy data from one sheet to another

1 Answers