How to copy only rows with data from one worksheet to another in a different workbook?

[dweasel]

So here is my issue. I have fumbled around multiple forums trying to find the answer. I am new to vba for excel and I have hacked together a macro from bits of code I found in these forums. It does what I need it to except for one caveat, the second part of the macro uses a set range but i realized as the sheet keeps getting bigger the row numbers will change. So I need a way to copy only rows with data in them to another worksheet in another workbook.
The first part of the macro goes through and hides every row that doesn't have today's date. it works great. the next part copies whats left and it works but as they are constantly adding to this sheet it will work once then the range will be wrong the next time they use it.

Sub automate()Dim cell As Range
For Each cell In Range("AB2:AB30000")
If cell.Value < Date And cell.Value <> Empty Then cell.EntireRow.Hidden = True
Next
Range("K28336:K28388,O28336:O28388,P28336:P28388,Q28336:Q28388,R28336:R28388,S28336:S28388,T28336:T28388,U28336:U28388,V28336:V28388,Y28336:Y28388,AA28336:AA28388,AB28336:AB28388").Select
Selection.Copy
Workbooks.Open ("\\gvwac09\Public\Parts\Test\2014 IPU\2014 IPU.xlsx")
Sheets("Historical Data").Activate
ActiveSheet.Range("c1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Paste
End Sub

Any help would be greatly appreciated.

 

[JackDanIce]

Welcome to the board. Try:

Sub automate1()

Dim i As Long
Dim ThisWorkbook As Workbook: Set ThisWorkbook = ActiveWorkbook
Const DestFile As String = "\\gvwac09\Public\Parts\Test\2014 IPU\2014 IPU.xlsx"

Application.ScreenUpdating = False

With ActiveSheet
    .AutoFilterMode = False
    i = .Range("AB" & .Rows.Count).End(xlUp).Row
    .Range("AB2:AB" & i).AutoFilter
    .Range("AB2:AB" & i).AutoFilter field:=1, Criteria1:=">" & Date
    .Range("K2:K" & i & ",O2:V" & i & ",Y2:Y" & i & ",AA2:AB" & i).SpecialCells(xlCellTypeVisible).Copy
End With
    
Workbooks.Open (DestFile)
With Sheets("Historical Data")
    .Range("C" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    .Range("C" & .Rows.Count).End(xlUp).PasteSpecial Paste:=xlPasteFormats
    .Paste
End With

If MsgBox("Save and close File 2014 IPU.xlsx?", vbYesNo, "Save File?") = vbYes Then
    ActiveWorkbook.Close savechanges:=True
Else
   ThisWorkbook.Activate
End With

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

End Sub

 

[dweasel]

Welcome to the board. Try:

Sub automate1()

Dim i As Long
Dim ThisWorkbook As Workbook: Set ThisWorkbook = ActiveWorkbook
Const DestFile As String = "\\gvwac09\Public\Parts\Test\2014 IPU\2014 IPU.xlsx"

Application.ScreenUpdating = False

With ActiveSheet
    .AutoFilterMode = False
    i = .Range("AB" & .Rows.Count).End(xlUp).Row
    .Range("AB2:AB" & i).AutoFilter
    .Range("AB2:AB" & i).AutoFilter field:=1, Criteria1:=">" & Date
    .Range("K2:K" & i & ",O2:V" & i & ",Y2:Y" & i & ",AA2:AB" & i).SpecialCells(xlCellTypeVisible).Copy
End With
    
Workbooks.Open (DestFile)
With Sheets("Historical Data")
    .Range("C" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    .Range("C" & .Rows.Count).End(xlUp).PasteSpecial Paste:=xlPasteFormats
    .Paste
End With

If MsgBox("Save and close File 2014 IPU.xlsx?", vbYesNo, "Save File?") = vbYes Then
    ActiveWorkbook.Close savechanges:=True
Else
   ThisWorkbook.Activate
End With

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

End Sub

Thank you so much I will try it now.

 

[dweasel]

It gets stuck on the End With right above With Application. it says End with without With.

 

[JackDanIce]

That's my mistake, a typo! It should have been End If, NOT End With. Here is the code, line in red corrected. Lines in blue are where you change the destination folder, file name

Sub automate1()

Dim i As Long
Dim ThisWorkbook As Workbook: Set ThisWorkbook = ActiveWorkbook
Const DestLoc As String = "\\gvwac09\Public\Parts\Test\2014 IPU\"
Const DestFile as String = "2014 IPU.xlsx"

Application.ScreenUpdating = False

With ActiveSheet
    .AutoFilterMode = False
    i = .Range("AB" & .Rows.Count).End(xlUp).Row
    .Range("AB2:AB" & i).AutoFilter
    .Range("AB2:AB" & i).AutoFilter field:=1, Criteria1:=">" & Date
    .Range("K2:K" & i & ",O2:V" & i & ",Y2:Y" & i & ",AA2:AB" & i).SpecialCells(xlCellTypeVisible).Copy
End With
    
Workbooks.Open (DestLoc&DestFile)
With sheets("Historical Data")
    .Range("C" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    .Range("C" & .Rows.Count).End(xlUp).PasteSpecial Paste:=xlPasteFormats
    .Paste
End With

If MsgBox("Save and close File " & DestFile & "?", vbYesNo, "Save File?") = vbYes Then
    ActiveWorkbook.Close savechanges:=True
Else
   ThisWorkbook.Activate
End If

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

End Sub

 

[dweasel]

wow that's some fast code. I like how i can sort on date, the only issue is it only copies two entries to the 2014 IPU workbook and they are dated 6/1/2013. I only want to end up copying any rows with today's date. other than that alot closer than i was. this is awesome actually getting help been frying my brain and eyeballs trying to figure this out. Let me give a little back story. We have inspectors that enter data into a sheet then it exports to a tracking sheet which is where this macro will run, then from there to the 2014 IPU workbook and onto the historical data sheet within that book. Right now they do this manually. Eventually they will have a database but not in the budget this year.

 

[JackDanIce]

Try:

Sub automate4()

Dim i As Long
Dim rng As Range
Dim ThisWorkbook As Workbook: Set ThisWorkbook = ActiveWorkbook
Const DestLoc As String = "\\gvwac09\Public\Parts\Test\2014 IPU\"
Const DestFile As String = "2014 IPU.xlsx"

Application.ScreenUpdating = False

With ActiveSheet
    .AutoFilterMode = False
    i = .Range("AB" & .Rows.Count).End(xlUp).Row
    Set rng = .Range("A1:AB" & i)
    rng.AutoFilter
    rng.AutoFilter Field:=28, Criteria1:=">=" & CLng(DateValue(Date))
    .Range("K2:K" & i & ",O2:V" & i & ",Y2:Y" & i & ",AA2:AB" & i).SpecialCells(xlCellTypeVisible).Copy
End With
    
Workbooks.Open (DestLoc & DestFile)
With sheets("Historical Data")
    .Range("C" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    .Range("C" & .Rows.Count).End(xlUp).PasteSpecial Paste:=xlPasteFormats
    .Paste
End With

If MsgBox("Save and close File " & DestFile & "?", vbYesNo, "Save File?") = vbYes Then
    ActiveWorkbook.Close savechanges:=True
Else
   ThisWorkbook.Activate
End If

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

End Sub

 

[dweasel]

Try:

Sub automate4()

Dim i As Long
Dim rng As Range
Dim ThisWorkbook As Workbook: Set ThisWorkbook = ActiveWorkbook
Const DestLoc As String = "\\gvwac09\Public\Parts\Test\2014 IPU\"
Const DestFile As String = "2014 IPU.xlsx"

Application.ScreenUpdating = False

With ActiveSheet
    .AutoFilterMode = False
    i = .Range("AB" & .Rows.Count).End(xlUp).Row
    Set rng = .Range("A1:AB" & i)
    rng.AutoFilter
    rng.AutoFilter Field:=28, Criteria1:=">=" & CLng(DateValue(Date))
    .Range("K2:K" & i & ",O2:V" & i & ",Y2:Y" & i & ",AA2:AB" & i).SpecialCells(xlCellTypeVisible).Copy
End With
    
Workbooks.Open (DestLoc & DestFile)
With sheets("Historical Data")
    .Range("C" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    .Paste
End With

With sheets("Daily Data")
    .Range("C" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    .Paste
End With

If MsgBox("Save and close File " & DestFile & "?", vbYesNo, "Save File?") = vbYes Then
    ActiveWorkbook.Close savechanges:=True
Else
   ThisWorkbook.Activate
End If

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

End Sub

So i modified it a little because it was double pasting in the historical sheet, then i copied the same line for the daily. works wonders you are amazing. now my last issue is that on the daily sheet I just need the data pasted to overwrite whats there starting at c2. This site forum has saved my sanity.