I have large amount of excel sheet where 16k records i want to break it into multiple sheets like in 2000 records in 1 excel sheets and if any think left so it should be add in next sheet please help me out of this.
Thanks in advance so much
Vijay Bhatt
I do not know how much you know about VBA but you can use following codes to achieve your goal. I will post 2 options. First macro will delete the lines which copied from the source sheet, second macro will keep source sheet values. All you need to do is update the code with the name of your source worksheet and how many lines you want in each generated sheet.
Update Items
Set CWS = Sheets("Sheet2") 'Source Worksheet name
LineNo = 5 ' Number of lines in each sheet
Macro 1: Will delete copied rows from source sheet.
Dim CWS As Worksheet
Dim LastRow As Long
Dim S_No As Long
Dim LineNo As Long
Set CWS = Sheets("Sheet2") 'Source Worksheet name
LastRow = Range("A" & Rows.Count).End(xlUp).Row
LineNo = 5 ' Number of lines in each sheet including header
S_No = 1
i = 1
While i < LastRow
CWS.Range("1:" & LineNo).Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Partition " & S_No
Sheets("Partition " & S_No).Range("A1").PasteSpecial
CWS.Range("2:" & LineNo).Delete Shift:=xlUp
LastRow = CWS.Range("A" & Rows.Count).End(xlUp).Row
S_No = S_No + 1
Wend
Macro 2: Will keep copied rows in source sheet.
Dim CWS As Worksheet
Dim LastRow As Long
Dim S_No As Long
Dim LineNo As Long
Set CWS = Sheets("Sheet2") 'Source Worksheet name
LastRow = Range("A" & Rows.Count).End(xlUp).Row
LineNo = 5 ' Number of lines in each sheet excluding header
S_No = 1
For i = 2 To LastRow
CWS.Range("1:1," & i & ":" & i + LineNo - 1).Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Partition " & S_No
Sheets("Partition " & S_No).Range("A1").PasteSpecial
i = i + Sheets("Partition " & S_No).Range("A" & Rows.Count).End(xlUp).Row - 1
S_No = S_No + 1
Next
UPDATE: I have updated the code to copy first row as a header to all sheets created. But please read the comment next to the LineNo variable.
Related
I know this question is too simple. But, I don't know how I will apply my logic in vba excel. I want to get or pull the data from one workbook (Book1.xls) to another workbook (Book2.xls). I need to get the values in Column A and B of Book1 and assigned it in Column A (Book2 - Details). Then, for every value in Added column, it should have a prefix of "Addition:", same with Deleted column, for every value in Deleted column, it should have a prefix of "Deletion". The range of Column A and B in Book1 can be change.
Thankyou.
This should do the trick
Sub AdditionDeletion()
Dim ws1 As Worksheet
Set ws1 = Workbooks("Book1").Worksheets("Compare")
Dim ws2 As Worksheet
Set ws2 = Workbooks("Book2").Worksheets("Details")
Dim current As Long
current = ws2.Range("A" & rows.count).End(xlUp).row + 1
Dim i As Long
For i = 3 To ws1.Range("B" & rows.count).End(xlUp).row
ws2.Range("A" & current) = "Addition:" & ws1.Range("B" & i).Value2
current = current + 1
Next i
For i = 3 To ws1.Range("A" & rows.count).End(xlUp).row
ws2.Range("A" & current) = "Deletion:" & ws1.Range("A" & i).Value2
current = current + 1
Next i
End Sub
1) I have a sheet named C.A.
I want to copy the range starting from B$3 to the last cell (which is of column H)
2) Then paste it to another sheet called 2017
To 2 cells below the (last cell of column B containing data)
I did the second one, but, cant define the first one.
Dim lastRow As String
lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 2
Range("B" & lastRow).Select
Selection.PasteSpecial
End Sub
Try this:
Dim ws_ca As Worksheet
Dim ws_17 As Worksheet
Dim nr_2017 As Long
Dim nr_ca As Long
Set ws_ca = ThisWorkbook.Worksheets("C.A.")
Set ws_17 = ThisWorkbook.Worksheets("2017")
nr_ca = ws_ca.Cells(Rows.Count, 8).End(xlUp).Row
nr_2017 = ws_17.Cells(Rows.Count, 2).End(xlUp).Row
ws_17.Range("B" & nr_2017 + 3 & ":H" & nr_2017 + nr_ca).Value = ws_ca.Range("B3:H" & nr_ca).Value
I have a excel table with a autofilter.
In the filtered table i only have few rows filtered.
My objective is icterate all visible rows to colect data to copy to anothe sheet.
I want a way to collect a variable with the the fisrt visible row number.
my draft code is:
Dim cnp As String
Dim nome As String
Dim filter_rng As Range
Dim rw As Range
Dim last_row As Long 'last visible data row
Dim dest_row As Long 'row to paste the colected data
Set filter_rng = Range("A5:Y" & last_row).Rows.SpecialCells(xlCellTypeVisible)
'collect data
For Each rw In filter_rng.SpecialCells(xlCellTypeVisible)
workshett(1).Activate
cnp = Range("a" & rw).Value
nome = Range("b" & rw).Value
'copy data to another worksheet first data line is cell A2
Worksheet(2).Activate
Range("A" & dest_row + 1).Value = cnp
Range("b" & dest_row + 1).Value = nome
Next rw
Your code contains several errors and you provide little additional information to allow us to help you, but to put in an attempt.
Please see below code and compare to yours, the below code is closest to what you are trying to do and is tested and working.
Dim cnp As String
Dim nome As String
Dim filter_rng As Range
Dim rw As Range
Dim last_row As Long 'last visible data row
Dim dest_row As Long 'row to paste the colected data
last_row = 200
dest_row = 1
Set filter_rng = Sheets(1).Range("A5:Y" & last_row)
'collect data
For Each rw In filter_rng.SpecialCells(xlCellTypeVisible)
'Worksheets(1).Activate
cnp = Sheets(1).Range("A" & rw.Row).Value
nome = Sheets(1).Range("B" & rw.Row).Value
'copy data to another worksheet first data line is cell A2
'Worksheets(2).Activate
Sheets(2).Range("A" & dest_row + 1).Value = cnp
Sheets(2).Range("B" & dest_row + 1).Value = nome
Next rw
I have the data of the following type in excel:
Year|Trade Flow|Partner|Commodity Code|Commodity|Qty Unit|Qty|Netweight (kg)|Trade Value (US$)
In the year column it ranges from 1990 to 2014. I need to develop a macro code such that it can filter the values based on year individually and then paste it in different sheets of the same excel file.
Any help in this regard,. would be great.
Thanks.
Loop through the rows. Each time you hit a new year, insert a sheet for that year and copy the rows to it.
This assumes your data is on sheet1 and you don't have sheets named 1990, 1991, 1992, etc.
This also assumes that your data is sorted by ColumnA(Year).
Private Sub CommandButton1_Click()
Dim ws As Excel.Worksheet
Dim strValue As String
Set ws = ActiveWorkbook.Sheets("Sheet1")
Dim jRow As Long
Dim lRow As Long
lRow = 1
jRow = 1
ws.Activate
'Loop through and copy the records to the new sheet.
Do While lRow <= ws.UsedRange.Rows.count
'If this is a new year, create a sheet for it.
If ws.Range("A" & lRow).Value <> strValue Then
strValue = ws.Range("A" & lRow).Value
Worksheets.Add(After:=Worksheets(Worksheets.count)).name = strValue
jRow = 1
End If
ws.Rows(lRow).Copy Destination:=Worksheets(strValue).Range("A" & jRow)
jRow = jRow + 1
lRow = lRow + 1
Loop
End Sub
This site has helped me immensely with VBA for a while now, so thanks for that! But I just can't seem to get this code to work and I've look at so many examples. What's happening is that I'm archiving data on another sheet once the current date is 4 days ahead of the due date. Everything works like it should, but every time the macro executes, the data on sheet2 is erased and copied over. I need my code to find the last row on sheet2 and copy the data from sheet1 to sheet2 so all the data is there. Thanks!
Sub archive()
Dim LastRow As Long
Dim i As Long
LastRow = Range("M" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
If Worksheets("Sheet1").Range("M" & i) - Date <= -4 And Worksheets("Sheet1").Range("N" & i).Value = "DONE" Then
Sheet2.Select
Range("A" & i).EntireRow.Value = Sheet1.Range("M" & i).EntireRow.Value
Sheet1.Range("M" & i).EntireRow.Delete
End If
If Worksheets("Sheet1").Range("L" & i) = "" Then
Exit For
End If
Next i
End Sub
Here I've taken your code and changed it to use worksheet objects. I've not tested this on any data as you haven't provided any to use, but it gives you an idea of how to implement it.
Also, in your code you weren't finding the last row of Sheet2, you were putting the data in row i, which starts at 3.
You also need to watch out when you delete the row of data from sheet1, as this shifts the rest of the data up, so the next iteration of the loop may not find the next row of data/ skip a row of data.
Sub archive()
Dim LastRow As Long
Dim LastRowSht2 As Long
Dim i As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim rowCount As Long
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
LastRow = sht1.Range("M" & Rows.Count).End(xlUp).Row
rowCount = 3
For i = 3 To LastRow
If sht1.Range("M" & rowCount) - Date <= -4 And sht1.Range("N" & rowCount).Value = "DONE" Then
LastRowSht2 = sht2.Range("A" & Rows.Count).End(xlUp).Row + 1 '+1 so it doesn't overwrite the last row
sht2.Range("A" & LastRowSht2).EntireRow.Value = sht1.Range("M" & rowCount).EntireRow.Value
sht1.Range("M" & rowCount).EntireRow.Delete
Else
rowCount = rowCount + 1
End If
If sht1.Range("L" & rowCount) = "" Then
Exit For
End If
Next i
' clean up
set sht1 = nothing
set sht2 = nothing
End Sub