Macro assistance

[linesy]

I've been trying to write a macro that will copy two sections of each worksheet into another file (location to be determined but called \positions.xls in order to use it to upload to Access) and that each extraction will append onto the end of the position file.

It's columns A:U, and needs to pick up from A14 to the end of the range (end at first blank cell in column A) for the first range and then one line below cell contents "For all transactions you must enter the effective date of the action. For any transfers you must enter the from and to center." to the end of the range (end at first blank cell in column A) for the second range.

This is where my macro fails because the first and second ranges can be variable in size and I get all or only some of the data. Can someone please point me in the right direction by VB knowledge is very limited???

Thanks so much!

 

[pbornemeier]

This should copy the two blocks from one page:

Sub CopyTwoBlocks()
    
    Dim lLastRow As Long
    Dim lNextWriteRow As Long
    Dim oFound As Object
    
    'Find next open cell in column A of the destination workbook/sheet
    lNextWriteRow = Workbooks("Positions.xls").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    'Find the last filled row after A14
    lLastRow = Range("A14").End(xlDown).Row
    
    'If selection now at bottom of worksheet, reset the lastrow value
    If Selection.Row = Rows.Count Then lLastRow = 14
    
    'Copy the block
    Range("A14:U" & lLastRow).Copy Destination:=Workbooks("Positions.xls").Sheets("Sheet1").Cells(lNextWriteRow, 1)
    
    'Find the text that identifies the start of the next block
    Set oFound = Cells.Find(What:="For all transactions you must enter", LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)
        
    'Find next open cell in column A of the destination workbook/sheet
    lNextWriteRow = Workbooks("Positions.xls").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    'Find the last filled row after the row after the marker text
    lLastRow = Range("A" & oFound.Row + 1).End(xlDown).Row
    
    'If selection now at bottom of worksheet, reset the lastrow value
    If Selection.Row = Rows.Count Then lLastRow = oFound.Row + 1
    
    'Copy the block
    Range(Cells(oFound.Row + 1, 1), Cells(lLastRow, "U")).Copy Destination:=Workbooks("Positions.xls").Sheets("Sheet1").Cells(lNextWriteRow, 1)
        
    Set oFound = Nothing
End Sub

 

[linesy]

Phil, thanks so much, this is great! I really appreciate your time.


Two questions, is there a way that the macro can do the paste as paste values, rather than the underlying formula and then delete rows where the cell in column "B"?

Susan

 

[pbornemeier]

Delete the

Destination:=Workbooks("Positions.xls").Sheets("Sheet1").Cells(lNextWriteRow, 1)

part of the 2 instances of the copy lines and add these lines below both copy lines:

    With Workbooks("Positions.xls").Sheets("Sheet1").Cells(lNextWriteRow, 1)
      .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
    End With

I don't understand the second part of your request, but this code can be adapted to what I think you were about to ask for:

Sub DeleteRowsWhereColumnBMeetsASpecifiedCriterion()
    Dim lX As Long
    Dim lLastColBRow As Long
    lLastColBRow = Cells(Rows.Count, 2).End(xlUp).Row
    For lX = lLastColBRow To 1 Step -1
        If Cells(lX, 2) = "Column B value to cause row to be deleted" Then
            Rows(lX).Delete
        End If
    Next
End Sub

<!-- / message --><!-- sig -->

 

[linesy]

Sorry Phil, I meant that I need to delete rows with a blank cell in column B
in the destination sheet "positions.xls" sheet 1.

The above code didn't do anything.

Thanks again, Sue

 

[pbornemeier]

Sue,
Change
If Cells(lX, 2) = "Column B value to cause row to be deleted" Then
to
If Cells(lX, 2) = "" Then

 

[linesy]

Thanks so much Phil this is great. I'd love to learn to write code this way

Thanks again for your help.

Susan