none
Instead of looping through one worksheet "RVP Local GAAP" how do i change it to two worksheets and two ranges? and then pasting values in two worksheets? RRS feed

  • Question

  • Instead of looping through one worksheet "RVP Local GAAP" how do I change the below code to loop through two worksheets along with two ranges? Not only "CurrentTaxPerLocalGAAP" but also a range called CurrentTaxPerGroupGAAP in WS2 and then also pasting values into not only RVP Local GAAP but also WS2.

    The below works but it checks one range and copies it into one worksheet. I want to change the range to two ranges in different worksheets.

    Sub Button4_Click()

    Dim strFileName As String
    Dim wb1 As Workbook
    Dim ws1 As Worksheet
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim cell As Range
    Dim rng As Range
    Dim rng2 As Range
    Dim RangeName As String
    Dim CellName As String
    Dim ValueToFind
    Dim dstRng As Range

    ''Set wb2 = ActiveWorkbook
    ''Set ws2 = wb2.Sheet("Output")
    ''ws2.Range("D1:D12").Copy

    ''Set wb1 = ActiveWorkbook

    strFileName = CreateObject("WScript.Shell").specialfolders("Desktop") & "\BAC GVP - Template_Update_121917.xlsm"
     
    If Dir(strFileName) <> vbNullString Then
        Set wb1 = Workbooks.Open(strFileName)
    Else
    MsgBox "Sorry, the file does not exist on your Desktop at this time, please drop a copy to your Desktop from server!"
    End If

    ''Set wb2 = ThisWorkbook
    ''Set ws2 = wb2.Sheets("Output")
    ''Set ws1 = wb1.Sheets("RVP Local GAAP")

    ''ws2.Range("D4:D12").Copy
    ''ws1.Range("G13:G21").PasteSpecial xlPasteValues

      ''RangeName = "myData"
      ''CellName = "G11:G83"
     
      ''Set cell = Worksheets("RVP Local GAAP").Range(CellName)
      ''ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell
     
      ''RangeName = "NamedRange"
      ''CellName = "C4:C12"
     
     
    Set wb2 = ThisWorkbook
    Set ws2 = wb2.Sheets("Output")
    Set ws1 = wb1.Sheets("RVP Local GAAP")
    Set rng = Range("CurrentTaxPerLocalGAAPProvision")
    ''Set rng2 = Range("NamedRange")
    ''Set rng2 = ValueToFind
    ''ValueToFind = ("NamedRange")

    'Loop through all the values in NamedRange
    For Each rng In ws2.Range("NamedRange")
        Set dstRng = Nothing
        On Error Resume Next
        Set dstRng = ws1.Range(rng.Value)
        On Error GoTo 0
        'Check that the range exists in destination sheet
        If Not dstRng Is Nothing Then
            'Check that the range exists in the appropriate area
            If Not Intersect(dstRng, ws1.Range("CurrentTaxPerLocalGAAPProvision")) Is Nothing Then
               'Transfer the value from the next column to the appropriate range in the
               'destination sheet
               dstRng.Value = rng.Offset(0, 1).Value
            End If
        End If
    Next

    End Sub
    • Edited by jane778 Sunday, January 14, 2018 8:43 PM
    Sunday, January 14, 2018 8:29 PM

All replies

  • Hi jane778,

    You had mentioned that,"Instead of looping through one worksheet "RVP Local GAAP" how do i change it to two worksheets and two ranges? and then pasting values in two worksheets"

    You can try to use 'Sheets(Sheet_Name)' and then refer to range in that sheet to paste the values.

    By this way you can paste the values to multiple Sheets.

    You can refer example below may help you to understand.

    Following code will match Sheet1 Column A with Sheet2 Column A and if the values get match then it will paste the values in Sheet3 and Sheet4.

    Sub demo()
    Dim lRow, x As Long
    
    Sheets("Sheet1").Select
    lRow = Range("A1").End(xlDown).Row
    
    For Each cell In Range("A2:A" & lRow)
        x = 2
        Do
            If cell.Value = Sheets("Sheet2").Cells(x, "A").Value Then
                cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                cell.EntireRow.Copy Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
               
            End If
            x = x + 1
        Loop Until IsEmpty(Sheets("Sheet2").Cells(x, "A"))
    Next
        
    End Sub
    

    Output:

    You can try to implement the above suggestion in your code to fulfil your requirement.

    If you have any further questions then you can try to post your sample workbook.

    We will try to make a test with it with your above posted code and try to provide a suggestions to solve the issue.

    Regards

    Deepak 


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, January 15, 2018 3:58 AM
    Moderator
  • Hi jane778,

    Is your issue solved?

    I find that you did not follow up this thread after posting the issue.

    If your issue is solved then I suggest you to post your solution and mark it as an answer.

    If your issue is still exist then try to refer the solution given by the community members.

    If then also you have any further questions then let us know about it.

    We will try to provide further suggestions to solve the issue.

    Thanks for your understanding.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, January 24, 2018 9:30 AM
    Moderator