Dynamic copy range with vba

[JoeyGaspard]

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

'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

 

[Fluff]

How about

Sub JoeyGaspard()

   With Sheets("PayrollReport")
      .AutoFilterMode = False
      .Range("B1", .Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, "*Due*"
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With
   
   'Clear Payroll Data BU 08
   
   Sheets("BU08Data").Range("A2:G100").ClearContents
   
   
   
   '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
   With Worksheets("BU08Data")
      .Range("I2:T" & .Range("I" & Rows.Count).End(xlUp)).Copy
      Worksheets("GeneralJournal").Range("B17").PasteSpecial Paste:=xlPasteValues
   End With
   
   'Clear Clipboard
   Application.CutCopyMode = False
   
   'Delete Blank Rows if No Data in cells in Column B
   Worksheets("GeneralJournal").Range("B17:B100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   
   
End Sub

 

[JoeyGaspard]

How about

Sub JoeyGaspard()

   With Sheets("PayrollReport")
      .AutoFilterMode = False
      .Range("B1", .Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, "*Due*"
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With
  
   'Clear Payroll Data BU 08
  
   Sheets("BU08Data").Range("A2:G100").ClearContents
  
  
  
   '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
   With Worksheets("BU08Data")
      .Range("I2:T" & .Range("I" & Rows.Count).End(xlUp)).Copy
      Worksheets("GeneralJournal").Range("B17").PasteSpecial Paste:=xlPasteValues
   End With
  
   'Clear Clipboard
   Application.CutCopyMode = False
  
   'Delete Blank Rows if No Data in cells in Column B
   Worksheets("GeneralJournal").Range("B17:B100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  
  
End Sub

For some reason, that added about 6000+ rows of blanks to the sheet I am pasting to

 

[Fluff]

In that case you column I has something in it down to that range.
What column can be used to determine the last row of data?

 

[JoeyGaspard]

In that case you column I has something in it down to that range.
What column can be used to determine the last row of data?

It needs to be column I, but I see nothing in that column past row 46?

 

[JoeyGaspard]

This may have something to do with it, not sure, it could be another issue altogether maybe, for some reason when it paste the data to the GeneralJournal sheet, it puts borders around every cell in H but only on the blank rows???

 

[JoeyGaspard]

 

[Fluff]

That suggest that you have something else going on. Probably an change event.

 

[JoeyGaspard]

That suggest that you have something else going on. Probably an change event.

Ok, not sure what that is/could be, I will do some googling and see what I can figure out. Thank you as always for your help.

 

[Fluff]

If you right click on the GeneralJournal tab & select View code, is there anything in the code window that opens up?
Also on the BU08Data sheet select I2 & hit Ctrl + down arrow, where do you end up?