Announcement

Collapse
No announcement yet.

Excel Macro copy

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Excel Macro copy



    Good Day

    I have the following which works fine with the exception that it copies last row value from column A to the next row in Column H which I don't want to
    How can I prevent this from happening?

    HTML Code:
    Sub passpop()
        Dim lr As Long, n As Long
        Dim rng As Range, cel As Range, pwd As Range
        Dim v As Variant
       
      With Worksheets("Sheet1")
                    v = .Cells(.Rows.Count, "A").End(xlUp).Value
                   .Cells(.Rows.Count, "A").End(xlUp).Cut .Cells(.Rows.Count, "H").End(xlUp)(2)
                  
    End With
       
    With Sheets("Sheet1")
        Set rng = .Range("H2", .Range("H" & .Rows.Count).End(xlUp))
    End With
    For Each cel In rng
        If cel.Offset(, 1) = "" Then
            With Sheets("Sheet2")
               lr = .Range("A" & .Rows.Count).End(xlUp).Row
               n = Application.WorksheetFunction.RandBetween(2, lr)
                Set pwd = .Range("A" & n)
                cel.Offset(, 1) = pwd.Value
                'move pwd to used list
                .Range("B" & .Rows.Count).End(xlUp).Offset(1).Value = pwd.Value
                pwd.Delete Shift:=xlUp
            End With
        End If
    Next cel
    End Sub
    Thanks

  • #2
    What do you want to happen?
    Alan

    Did you debug your code first? http://www.cpearson.com/excel/DebuggingVBA.aspx
    FORUM RULES----->http://www.ozgrid.com/forum/announcement.php?f=8

    If someone has helped you, say "thank you" by clicking on the Like Button.

    Comment


    • #3
      HI

      I have two Sheets (Sheet 1 and Sheet 2) . Column A in Sheet2 contains random 5 digit numbers. I want to copy the last number from Sheet 2 Column B to the last row to Sheet 1 column H

      Comment


      • #4
        This VBA will copy the last number in column B of Sheet2 to the last occupied cell in column H of Sheet1.

        Code:
        Option Explicit
        
        Sub farhadj()
            Dim s1 As Worksheet, s2 As Worksheet
            Dim lr As Long, lr2 As Long
            Set s1 = Sheets("Sheet1"): Set s2 = Sheets("Sheet2")
            lr = s1.Range("H" & Rows.Count).End(xlUp).Row
            lr2 = s2.Range("B" & Rows.Count).End(xlUp).Row
            s2.Range("B" & lr2).Copy
            s1.Range("H" & lr ).PasteSpecial xlPasteValues
        End Sub
        If you wish to stay with your current code and only amend the destination then change this line of code

        Code:
        .Range("B" & .Rows.Count).End(xlUp).Offset(1).Value = pwd.Value
        to
        Code:
        .Range("B" & .Rows.Count).End(xlUp).Value = pwd.Value
        Alan

        Did you debug your code first? http://www.cpearson.com/excel/DebuggingVBA.aspx
        FORUM RULES----->http://www.ozgrid.com/forum/announcement.php?f=8

        If someone has helped you, say "thank you" by clicking on the Like Button.

        Comment


        • #5
          Hi

          I have used my existing code and the amended line as you suggested which works - thanks. However on sheet1 I have an issue whereby contents of column A are deleted and copied to column H which I don't want to happen. Can you please assist with this.
          Thanks

          Comment


          • #6
            It appears that this line in your code
            Code:
              pwd.Delete Shift:=xlUp
            is deleting the contents of column A. Why do you have it in your code if you don't want it to delete the contents.
            Alan

            Did you debug your code first? http://www.cpearson.com/excel/DebuggingVBA.aspx
            FORUM RULES----->http://www.ozgrid.com/forum/announcement.php?f=8

            If someone has helped you, say "thank you" by clicking on the Like Button.

            Comment


            • #7


              HI

              Everything worked as you suggested. Thanks a million for your assistance
              Thanks

              Comment

              Working...
              X