tonywatsonhelp
Well-known Member
- Joined
- Feb 24, 2014
- Messages
- 3,194
- Office Version
- 365
- 2019
- 2016
- Platform
- Windows
Hi Everyone,
I have a macro that works great, its purpose is to go to a folder open each CSV file and filter the data and copy it into this document,
it all works great until we get to the part where its coping more data then i have rows left, at which point it errors out and because i have a on error resume next, it just doesn't paste the data,
so I need help, i dont mid how its done but basicly i need the macro edited so if the number of rows copied are more than the empty row in sheet "Submissions" it creates a new tab and paste it in there and so on if it fills up again does the same.
so instead of one tab i get several tabs, not worried about headers or filling up the tabs happy if theres 400,000 rows and it copies 500,000 rows to start anew sheet, dont care what the new sheets are called as long as it works
I hope thats clear, but to summories again
macro below needs chnaging so that if it copies more rows then are left in the sheet to paste into it starts a new tab and continues adding new tabs until all data is copied over.
heres my code please help if you can
Tony
I have a macro that works great, its purpose is to go to a folder open each CSV file and filter the data and copy it into this document,
it all works great until we get to the part where its coping more data then i have rows left, at which point it errors out and because i have a on error resume next, it just doesn't paste the data,
so I need help, i dont mid how its done but basicly i need the macro edited so if the number of rows copied are more than the empty row in sheet "Submissions" it creates a new tab and paste it in there and so on if it fills up again does the same.
so instead of one tab i get several tabs, not worried about headers or filling up the tabs happy if theres 400,000 rows and it copies 500,000 rows to start anew sheet, dont care what the new sheets are called as long as it works
I hope thats clear, but to summories again
macro below needs chnaging so that if it copies more rows then are left in the sheet to paste into it starts a new tab and continues adding new tabs until all data is copied over.
heres my code please help if you can
Tony
VBA Code:
Sub ImportWorksheets()
Application.DisplayAlerts = False
RelativePath = ThisWorkbook.Path & "\"
Dim sFile As String
Dim wbSource As Workbook
Dim wbArchive As String, wbNew As String, KillFile As String
sFile = Dir(RelativePath & "*.csv")
Do Until sFile = ""
Set wbSource = Workbooks.Open(RelativePath & sFile)
KillFile = wbSource.Path & "\" & wbSource.Name
On Error Resume Next
If ActiveSheet.Range("G1") = "isrcs" Then
LR1 = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("H1") = "ISRC"
ActiveSheet.Range("H2:H" & LR1).FormulaR1C1 = "=LEFT(RC[-2],2)"
ActiveSheet.Range("$A$1:$H$" & LR1).AutoFilter Field:=8, Criteria1:="GB"
ActiveSheet.Range("$A$1:$H$" & LR1).AutoFilter Field:=5, Criteria1:=""
ActiveSheet.Range("$A$2:$H$" & LR1).SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Activate
LR2 = Sheets("Production").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Production").Range("A" & LR2).PasteSpecial xlPasteValues
Else
'Save Archive
wbArchive = RelativePath & "Archived\" & wbSource.Name
wbSource.SaveAs Filename:=wbArchive
End If
'Delete Sourcebook
wbSource.Close False
Kill KillFile
sFile = Dir()
Loop
Set wbSource = Nothing
Application.DisplayAlerts = True
End Sub