Dynamic copy range with vba

JoeyGaspard

Board Regular
Joined
Jul 22, 2019
Messages
147
Hi All, I have the code below in a spreadsheet that performs multiple functions. In the section "Copy BU 08 Data to Atlas Upload" it selects a sheet and a range and copies it, then paste it to another sheet, and that works fine, but I need it to be dynamic. This upload varies week to week, in other words, some weeks there could be 20 rows of data, some weeks it could be as many as 60? When there is nothing in the rows, it puts zero's in the sheet it copies to, and zeros make my upload bomb out. I also have a section of code at the very bottom that should delete any rows where cells in column B on the target sheet are blank, but it wont work if there is data in that row at all, if the whole row is blank, it works and will delete it. Please help! Thanks in advance

VBA Code:
'Remove all account numbers with Due to From in Description
Sub ProcessPayroll08()

With Sheets("PayrollReport")
        .AutoFilterMode = False
        With .Range("B1", .Range("B" & Rows.Count).End(xlUp))
            .AutoFilter 1, "*Due*"
            On Error Resume Next
            .Offset(1).SpecialCells(12).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With
   
'Clear Payroll Data BU 08

  Sheets("BU08Data").Select
  Range("A2:G100").Select
  Selection.ClearContents
  Range("A2").Select


'Copy Data from Payroll Report to BU 08
Dim Ws As Worksheet

Set Ws = Worksheets("BU08Data")
With Worksheets("PayrollReport")
   .Range("A1:G1").AutoFilter 1, "08-*"
   .AutoFilter.Range.Offset(1).Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
   .AutoFilterMode = False
End With

'Copy BU 18 Data to Atlas Upload
Worksheets("BU08Data").Range("I2:T66").Copy
Worksheets("GeneralJournal").Range("B17").PasteSpecial Paste:=xlPasteValues

'Clear Clipboard
Application.CutCopyMode = False

'Delete Blank Rows if No Data in cells in Column B
On Error Resume Next

    Range("B17:B100").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("B17").Select
End Sub
 
All the quotes inside the formula need to be doubled up like ""Ledger""
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Forum statistics

Threads
1,214,943
Messages
6,122,376
Members
449,080
Latest member
Armadillos

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top