locked
Copy paste using IF statements RRS feed

  • Question

  • Hi,

    This is my first post in a forum so bear with me on my explanation. I am trying to copy and paste data between workbooks. I am trying to have certain cells in workbook 1 paste into the first blank section in workbook 2. Workbook 2 has 20 separate sections that are all the same and are all blank. When I run a macro for one section in workbook 1, I want it to paste in section 1 of workbook 2 first, if it is blank. If not, then paste into section 2, if not blank, section 3, etc....

    When trying to run these IF statements, the result is the paste keeps occurring in each section of workbook 2, instead of pasting once in the first blank section, then stopping the macro. I know I have nested IF statements in the macro, so it does run through all of the IF statements which is why it keeps pasting the same section in workbook 1 into each section in workbook 2, instead of pasting once and ignoring the rest of the IF statements. 

    My question is....is there a way to have the code read each section of workbook 2 to see what sections are blank, then paste only one time? Or is there a better way to do this instead of using IF statements? I will add that the sections in workbook 2 are non-contiguous cells so an offset function wouldn't really work here I don't believe. I have part of the macro attached, any feedback would be greatly helpful because I am stumped. Thank you!

    Sub CP()
    
       Dim myCell As Range
     
     
        Set A04 = Workbooks("Tip Report.xlsm").Worksheets("functions").Range("A04")
     
       
        If IsEmpty(A04) Then
        
            Workbooks("WCCC Function Schedules.xlsm").Worksheets("functions").Range("B03").Copy
            
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("A04").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
            Workbooks("WCCC Function Schedules.xlsm").Worksheets("functions").Range("A03").Copy
            
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("A06").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
        
            Worksheets("functions").Range("R03:AD03").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("B05").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
        Worksheets("functions").Range("R04:AD04").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("C05").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
            Worksheets("functions").Range("R05:AD05").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("E05").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
        Else
        
     Workbooks("WCCC Function Schedules.xlsm").Worksheets("functions").Range("B03").Copy
        
          
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("A21").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
          Range("A03").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("A23").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
            Worksheets("functions").Range("R03:AD03").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("B22").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
        
        Worksheets("functions").Range("R04:AD04").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("C22").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
            Worksheets("functions").Range("R05:AD05").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("E22").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
    End If
     Set A21 = Workbooks("Tip Report.xlsm").Worksheets("functions").Range("A21")
     
    If IsEmpty(A21) Then
    
    Workbooks("WCCC Function Schedules.xlsm").Worksheets("functions").Range("B03").Copy
        
          
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("A21").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
          Range("A03").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("A23").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
            Worksheets("functions").Range("R03:AD03").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("B22").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
        
        Worksheets("functions").Range("R04:AD04").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("C22").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
            Worksheets("functions").Range("R05:AD05").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("E22").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
    Else
    
    Workbooks("WCCC Function Schedules.xlsm").Worksheets("functions").Range("B03").Copy
        
          
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("A38").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
          Range("A03").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("A40").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
            Worksheets("functions").Range("R03:AD03").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("B39").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
        
        Worksheets("functions").Range("R04:AD04").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("C39").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
        
            Worksheets("functions").Range("R05:AD05").Copy
        
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("E39").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False
    End If
    
    End Sub
    

    Thursday, April 16, 2020 3:30 PM

All replies

  • To:  Adpont21
    re:  posted code

    It is just too much code to try to go thru.
    I do have some general suggestions.

    Use Option Explicit as the first line in your code module.
      It forces you to declare all variables and will notify you if one is mispelled.
    Declare all variables at the top of the Sub.
    Do not use variables that are identical to terms Excel uses or identical to cell addresses.
    Avoid using "Select" or "Activate" as your code will execute properly if you just identify the workbook/worksheet or range.
    An example ...

    Dim WBcc as Excel.Workbook, WBtips as Excel.Workbook
    Dim ShtTips as Excel.Worksheet, ShtFunc as Excel.Worksheet
    Dim Rng04 as Excel.Range, lngCount As Long

    Set WBcc = Application.Workbooks("WCCC Function Schedules.xlsm")
    Set WBtips = Application.Workbooks("Tip Report.xlsm")

    Set ShtTips =WBtips.Worksheets("Functions")
    Set ShtFunc = WBcc.Worksheets("Functions")

    'This...

        Windows("WCCC Function Schedules.xlsm").Activate
        Application.CutCopyMode = False   
        Worksheets("functions").Range("R04:AD04").Copy   
        Windows("Tip Report.xlsm").Activate
        Sheets("Functions").Select
        Range("C39").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True

    'Can become...
    WBccc.ShtFunc.Range("R04:AD04").Copy Destination:=WBTips.WStips.Range("C39")

    '---

    There is much less code, it is easier to understand and problems are easier to remedy.
    NOTE: 
    lngCount = Application.WorksheetFunction.CountA(a specific range)
    If lngCount is not zero there is something in the range.
    Hope the above helps.
    '---



    The free workbook "List of Greatest Films of the 20th Century" ranks over 9000 movies.
    (almost all viewed by the man who ranked them)
    Sort the list by title, rank, director or date.

    Friday, April 17, 2020 4:43 AM
  • Hi,

    Thank you for your timely response! This will definitely help with shortening the overall macro. 

    Do you happen to know if there is a way for the code to only copy and paste one time once it has found the blank section in workbook 2 instead of running through all of the IF statements in the macro and pasting in each of the empty sections? 

    I just need it to paste the data in the first empty section in workbook 2 and then stop running the macro. Currently it is pasting into the empty section in workbook 2, then running the rest of the IF statements in the macro and pasting the same data into each empty section below the initial one in workbook 2. 

    Thank you for your assistance

    Saturday, April 18, 2020 1:08 AM
  • To:  Adoint21
    re:  stop after first successful paste

    [Edit] I used the copy cells to check if they are empty, it should be the paste cell that are checked.
    [Edit] 04/18/2020 - corrected cell entries

    Note the '<<<< marked lines.  They need to be repeated after each Application.CutCopyMode line
    If the range is one cell use IsEmpty.
    Again, repeat this all the way down and finish it off with End If.
    The code excerpt below shows the first few.  Note the lines marked with '<<<<

    At the first empty cells, the code will paste and then skip to the End If.

    '---

    Sub CP()
      Dim myCell As Range
      Set A04 = Workbooks("Tip Report.xlsm").Worksheets("functions").Range("A04")
      If IsEmpty(A04) Then                                                                                '<<<<
      Workbooks("WCCC Function Schedules.xlsm").Worksheets("functions").Range("B03").Copy
          
      Windows("Tip Report.xlsm").Activate
      Sheets("Functions").Select
      Range("A04").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=True
      Windows("WCCC Function Schedules.xlsm").Activate
      Application.CutCopyMode = False
     
      ElseIf IsEmpty(Workbooks("Tip Report.xlsm").Worksheets("functions").Range("A06")) Then '<<<<
      Workbooks("WCCC Function Schedules.xlsm").Worksheets("functions").Range("A03").Copy
          
      Windows("Tip Report.xlsm").Activate
      Sheets("Functions").Select
      Range("A06").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=True
      Windows("WCCC Function Schedules.xlsm").Activate
      Application.CutCopyMode = False
     
      ElseIf IsEmpty(Workbooks("Tip Report.xlsm").Worksheets("functions").Range("B05")) Then  '<<<<            
      Worksheets("functions").Range("R03:AD03").Copy
     
      Windows("Tip Report.xlsm").Activate
      Sheets("Functions").Select
      Range("B05").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=True
      Windows("WCCC Function Schedules.xlsm").Activate
      Application.CutCopyMode = False
     
      ElseIf IsEmpty(Workbooks("Tip Report.xlsm").Worksheets("functions").Range("C05")) Then     '<<<<
      Worksheets("functions").Range("R04:AD04").Copy
     
      'More of the same
       End If


    Saturday, April 18, 2020 2:40 AM
  • NOTE:  corrections made in prior post.

    Saturday, April 18, 2020 12:31 PM