I'm trying to create a macro that would find the maximum numerical value in a column (which also contains text) and inserts a new row with that value +1.
For some reason it won't work and just keeps the original number, it also messes up the conditional formatting I have in column D even if that column is locked.
Sub_Move()
Set wk1 = Sheet1
Set wk2 = Sheet4
Set wk3 = Sheet5
Dim mynumber As Long
Application.ScreenUpdating = False
Sheet1.Unprotect
Sheet4.Unprotect
Sheet5.Unprotect
mynumber = 1
'Move-Characterisation'
Worksheets("Characterisation").Activate
For i = 1000 To 15 Step -1
If Range("W" & i).Value = "Completed" Then
Worksheets("Burn").Activate
Range("B15:W15").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B15:W15").Interior.ColorIndex = xlNone
End If
Worksheets("Characterisation").Activate
If Range("W" & i).Value = "Completed" Then
Range("W" & i).Select
Range("W" & i).Value = "Delete"
Range(ActiveCell, ActiveCell.Offset(0, -21)).Select
Selection.Copy
Worksheets("Burn").Activate
Range("B15").Select
ActiveSheet.Paste
Range("W15").ClearContents
**MaxVal1 = Application.WorksheetFunction.Max(wk2.Range("D15:D1000"))
Range("D15").Value = MaxVal1 + 1**
End If
Worksheets("Characterisation").Activate
If Range("W" & i).Value = "Delete" Then
Range("W" & i).Select
Range(ActiveCell, ActiveCell.Offset(0, -21)).Select
Selection.Delete Shift:=xlUp
End If
Next
I would be grateful for any help.
Related
I recorded a macro, which I want to modify in order to use it automatically in multiple ranges in the Excel worksheet. Here's the code:
Sub Macro1()
For i = 6 To 22370 Step 5
ActiveWorkbook.SaveAs Filename:= _
"tute.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Rows(i:i).Select
Range("D" & i).Activate
Selection.Insert Shift:=xlDown
Range("D" & i).Select
ActiveCell.FormulaR1C1 = "xyz"
Range("A"&"i-1":"C"&"i-1").Select
Selection.Copy
Range("A" & i).Select
ActiveSheet.Paste
Range("E" & i).Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C*R[4]C"
Range("E" & i).Select
Selection.AutoFill Destination:=Range("E37:AO37"), Type:=xlFillDefault
Range("E"&i:"AO"&i).Select
Range("D" & i).Select
Next
End Sub
I would like to use the variable "i" to call specific rows, as in the case of Rows(i:i).Select or a range such as Range("E"&i:"AO"&i).Select, but I get an error message: "Expected: list separator or )"
Can you help pls?
Thank you in advance
Besides my comments above, here's a quick rewrite to get rid of all of the superfluous .Activate and .Select lines. Those are for humans, VBA doesn't need to select something before acting on it. It can just act on it directly.
Sub Macro1()
'This line shouldn't be in your for loop otherwise you save this workbook like 4000 times
ActiveWorkbook.SaveAs Filename:="tute.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
For i = 6 To 22370 Step 5
'No reason to select the row since we just go ahead and activate a particular cell immediately afterwords
'Rows(i:i).Select
'No reason to "Activate" the cell. We can just shift it down without highlighting the thing for the user
'Range("D" & i).Activate
Range("D" & i).Insert Shift:=xlDown
'No need to .Select. Just change the formula directly.
'Range("D" & i).Select
Range("D" & i).FormulaR1C1 = "xyz"
'Again, no need to .Select. And we can do the copy/paste in one line
'Range("A"&"i-1":"C"&"i-1").Select
'Selection.Copy
'Range("A" & i).Select
'ActiveSheet.Paste
Range("A" & i-1 & ":C" & i-1).Copy Destination:=Range("A" & i)
'Removing superfluous select again
'Range("E" & i).Select
'Also superfluous code that isn't needed
'Application.CutCopyMode = False
'Application.CutCopyMode = False
Range("E" & i).FormulaR1C1 = "=R[-1]C*R[4]C"
'Range("E" & i).Select
Range("E" & i).AutoFill Destination:=Range("E37:AO37"), Type:=xlFillDefault
'Superfluous selects
'Range("E"&i:"AO"&i).Select
'Range("D" & i).Select
Next
End Sub
And then cleaned up to remove all of that:
Sub Macro1()
ActiveWorkbook.SaveAs Filename:="tute.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
For i = 6 To 22370 Step 5
'Shift column D for this line down a row (add a new empty cell for this line)
Range("D" & i).Insert Shift:=xlDown
'Change the value to xyz of column D for this line (the new cell)
Range("D" & i).FormulaR1C1 = "xyz"
'Copy three lines in column A:C and paste 1 line down
Range("A" & i-1 & ":C" & i-1).Copy Destination:=Range("A" & i)
'Change the formula in column E for this line
Range("E" & i).FormulaR1C1 = "=R[-1]C*R[4]C"
'Not sure if this is what you are actually after here. Perhaps that should be `Range("E" & i & ":AO" & i)?`
Range("E" & i).AutoFill Destination:=Range("E37:AO37"), Type:=xlFillDefault
Next
End Sub
I'm trying to select multiple columns for i rows depending on a For loop. The idea is to check whether a specific cell meets the criteria. If so, copy the formulas associated with that specific segment to the same row as that observation.
i.e:
for i = 13
If O(i) = segment A, copy and paste formula from $P$1 to P(i)
AND
Copy and paste formulas in T1:CV1 to T(i) : CV (i)
(Please keep in mind there are hidden columns between T and CV, I assume these won't have anything to do with the outcome since they are hidden but wanted to note regardless.)
So far, I've tried using the code : Range("T" & i : "CV" & i).Select . I know this is wrong but just wanted to give an idea. The full code is attached below. Any help is appreciated!
Sub mastersheet()
Dim i As Integer
Sheets("Master").Select
For i = 13 To 400
If Range("O" & i).Value = "A" Then
Range("P1").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T1:CV1").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
ElseIf Range("O" & i).Value = "B" Then
Range("P2").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T2:CV2").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
ElseIf Range("O" & i).Value = "C" Then
Range("P3").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T3:CV3").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
ElseIf Range("O" & i).Value = "D" Then
Range("P4").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T4:CV4").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
ElseIf Range("O" & i).Value = "E" Then
Range("P5").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T5:CV5").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
ElseIf Range("O" & i).Value = "F" Then
Range("P6").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T6:CV6").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
ElseIf Range("O" & i).Value = "G" Then
Range("P7").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T7:CV7").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
ElseIf Range("O" & i).Value = "H" Then
Range("P8").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T8:CV8").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
ElseIf Range("O" & i).Value = "I" Then
Range("P9").Select
Selection.Copy
Range("P" & i).Select
ActiveSheet.Paste
Range("T9:CV9").Select
Selection.Copy
Range("T" & i : "CV" & i).Select
ActiveSheet.Paste
End If
Next i
End Sub
Take a look at Select Case
Sub mastersheet1()
Dim i As Integer, ws As Worksheet, n As Integer
Set ws = Sheets("Master")
With ws
For i = 13 To 400
Select Case .Range("O" & i).Value2
Case "A": n = 1
Case "B": n = 2
Case "C": n = 3
Case "D": n = 4
Case "E": n = 5
Case "F": n = 6
Case "G": n = 7
Case "H": n = 8
Case "I": n = 9
Case Else: n = 0
End Select
If n > 0 Then
.Range("P" & n).Copy .Range("P" & i)
.Range("T" & n & ":CV" & n).Copy .Range("T" & i & ":CV" & i)
End If
Next
End With
End Sub
The problem with the copy/paste method is that it is quite slow and inefficient. I would rather use arrays. Here is an example:
Sub mastersheet()
Dim i As Integer
Dim arr As Variant 'This is for storing the array
Sheets("Master").Select
For i = 13 To 400
If Range("O" & i).Value = "A" Then
'This is faster than copy/pasting
Range("P" & i) = Range("P1")
arr = Range("T1:CV1")
Range("T" & i & ": CV" & i) = arr
End If
Next i
End Sub`
Please, try the next compact code. It does not need any selection:
Sub masterSheet()
Dim sh As Worksheet, i As Long, arr, arrL, arrNo, mtch
Set sh = Sheets("Master")
arrL = Split("A,B,C,D,E,F,G,H,I", ",") 'the array used to match the cell value
arrNo = Array(1, 2, 3, 4, 5, 6, 7, 8, 9) 'the array to return row to be copyed (based on mtch)
arr = sh.Range("O1:O400") 'place the range in an array, for faster iteration
Application.Calculation = xlCalculationManual 'calculate formula result only of the end
For i = 13 To 400
mtch = Application.match(arr(i, 1), arrL, 0) 'match the letter value
If IsNumeric(mtch) Then 'if a match exists:
sh.Range("P" & arrNo(mtch - 1)).Copy Destination:=sh.Range("P" & i) 'use the index from arrNo
sh.Range("T" & arrNo(mtch - 1) & ":CV" & arrNo(mtch - 1)).Copy sh.Range("T" & i) 'use the index from arrNo
End If
Next i
Application.Calculation = xlCalculationAutomatic 'now calculate copied formulas
MsgBox "Ready..."
End Sub
We run an SQL query and paste the results in sheet1,
then transpose the results data to sheet2, then email sheet2 data to someone.
I’ve written the vba code for the above task but im not getting these required results:
Line break is not need like in the below screenshot
Need to remove space vbtab between two sentences in email body
Format of the email should in plain text
Is there any possibility for running an SQL query automatically through VBA code? If yes please suggest.
Below is my code
Option Explicit
Sub sendemail_excel()
Sheet2.Cells.Clear
Worksheets("sheet1").Activate
Range("A1").Activate
Do Until ActiveCell.Value = ""
Sheet1.Activate
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
Worksheets("Sheet2").Activate
Range("B" & Rows.Count).End(xlUp).Select
ActiveCell.Offset(2, 0).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, Transpose:=True, skipblanks:=True
'ActiveCell.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, Transpose:=True, skipblanks:=True
'ActiveCell.Offset(1, 0).Activate
'Range("B1").Select
'ActiveCell.End(xlDown).Activate
'ActiveCell.Offset(2, 0).Activate
Range("B" & Rows.Count).End(xlUp).Offset(-2, 0).NumberFormat = "M/D/YYYY H:MM:SS AM/PM"
Range("B" & Rows.Count).End(xlUp).Select
ActiveCell.Offset(-4, -1).Value = "FEEDFILENAME="
ActiveCell.Offset(-3, -1).Value = "RECIPIENT="
ActiveCell.Offset(-2, -1).Value = "PROCESSEDTIME="
ActiveCell.Offset(-1, -1).Value = "PROCESSSTATUS="
ActiveCell.Offset(0, -1).Value = "NUMBEROFROWS="
Worksheets("sheet1").Activate
Loop
Columns.AutoFit
Range("B:B").HorizontalAlignment = xlLeft
Application.ScreenUpdating = False
Application.CutCopyMode = False
Range("B" & Rows.Count).End(xlUp).Select
ActiveCell.Select^
Range(Selection, Cells(3, 1)).HorizontalAlignment = xlLeft
Sheet2.Activate
Range("B" & Rows.Count).End(xlUp).Select
ActiveCell.Select
Range(Selection, Cells(3, 1)).Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = "Hi abc Team - This is the confirmation mail regarding the files, which xyz" & " " & Date - 1
.Item.To = "chinnolamanohar#gmail.com"
.Item.CC = "chinnolamanohar#gmail.com"
.Item.Subject = "Confirmation for earnings feed from abc equity research to xyz"
.Item.Send
End With
End Sub
You can run queries directly against a database, lots of documentation online.
Your connection string will vary on database type - MSSQL, MySQL etc.
Accessing SQL Database in Excel-VBA
https://www.ptr.co.uk/blog/using-excel-vba-query-sql-server-database
I know a bit of VBA, however I got a problem, I am trying to write a code that will copy all data from 1 sheet, append/paste it into the next blank cell in sheet 2 and then remove the data from sheet 1. I am using below code, but I get cell values replaced by the word TRUE.
Sub Instal_Sum_Paste()
ActiveWorkbook.Sheets("Vehicle working").Select
Dim N As Long
N = Cells(6, 2).End(xlDown).Row
Set DT = Range("b6:G" & N)
DT.Copy
ActiveWorkbook.Sheets("Installation Summary").Select
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
ActiveCell.Value = DT.PasteSpecial(xlPasteValues)
ActiveWorkbook.Sheets("Vehicle working").Select
DT.Select
Selection.ClearContents
MsgBox "done", vbOKOnly, "done"
End Sub
I managed to find an answer, its silly I know:
Sub Instal_Sum_Paste()
ActiveWorkbook.Sheets("Vehicle working").Select
Dim N As Long
N = Cells(6, 2).End(xlDown).Row
Set DT = Range("b6:G" & N)
DT.Select
Selection.Copy
ActiveWorkbook.Sheets("Installation Summary").Select
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
ActiveWorkbook.Sheets("Vehicle working").Select
DT.Select
Selection.ClearContents
MsgBox "done", vbOKOnly, "done"
End Sub
I am writing a vba macro to achieve the following but do not how to implement it. Would any please provide some guidance?
Currently, the data is as follows(subitem spans from column B onwards):
ITEM ONE [Subitem one... ]
ITEM ONE [Subitem two ...]
ITEM ONE [Subitem three...]
ITEM TWO [Subitem one ...]
ITEM THREE [Subitem one...]
ITEM Three [Subitem two...]
The following is what the data should look like in a separate sheet:
ITEM ONE
--------
Subitem one
Subitem two
Subitem three
ITEM TWO
--------
Subitem one
ITEM THREE
----------
Subitem one
Subitem two
Any guidance/help will be greatly appreciated.
Edited: solution as follows:
r = Range("a65536").End(xlUp).Row
c = Range("IU1").End(xlToLeft).Column
a = Split(Cells(, c).Address, "$")(1)
MsgBox "last row with data is " & r & " and last column with data is " & a & "", vbOKOnly, "LastRow and LastCol"
rr = r + 1
Application.Visible = False
Range("A1:" & a & r & "").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("owssvr(1)").Select
Sheets.Add
'by default select first record and paste in reports sheet
Sheets("owssvr(1)").Select
Range("b2").Select
Selection.Copy
Sheets(1).Select
Range("b2").Select
ActiveSheet.Paste
'paste header below it
Sheets("owssvr(1)").Select
Range("c1:" & a & "2").Select
Selection.Copy
Sheets(1).Select
Range("b3").Select
ActiveSheet.Paste
For i = 3 To r
Sheets(2).Select
'Program name is same as above, dont copy name but row starting from next col, switch to other sheet, find last row in col B, add one to last row and paste
If Cells(i, 2).Value = Cells(i - 1, 2) Then
Range("C" & i & ":" & a & i & "").Select
Selection.Copy
Sheets(1).Select
'Range("b3").Select
lr2 = Range("b65536").End(xlUp).Row
Range("B" & lr2 + 1 & "").Select
ActiveSheet.Paste
Else
'if name is not same as above, copy name, find last row, add two to add a gap from prev program name, paste program name, move to next row and paste remaining cols
Sheets(2).Select
Range("B" & i & "").Select
Selection.Copy
Sheets(1).Select
lr2 = Range("b65536").End(xlUp).Row
Range("B" & lr2 + 2 & "").Select
ActiveSheet.Paste
'copy headers
Sheets(2).Select
Range("c1:" & a & "1").Select
Selection.Copy
Sheets(1).Select
lr2 = Range("b65536").End(xlUp).Row
Range("B" & lr2 + 1 & "").Select
ActiveSheet.Paste
'copy cells(row, col+1)
Sheets(2).Select
Range("C" & i & ":" & a & i & "").Select
Selection.Copy
Sheets(1).Select
'Range("b3").Select
lr2 = Range("b65536").End(xlUp).Row
Range("B" & lr2 + 1 & "").Select
ActiveSheet.Paste
End If
Next
What you're asking for can be done with a PivotTable. I'm working in Excel 2010, but 2003 should probably have the same functionality. This is how it would look like.
The naive VBA approach I was going to do (which I guess you've implemented) was looping through all the items, doing comparisons, and adding them one at a time to the new worksheet. This can be made a bit more efficient if you store the initial range (of 2 columns) in an array, loop through that and store the output in a 2nd array, then copy the array back to a range.
I'm not sure how much data you have or how long that operation takes. Another alternative would be to use the macro recorder to make a PivotTable and copy the data from there to a new sheet. Here's an example, though you'd want to change the worksheet and range references to make them explicit/dynamic. The example data range is A1:B9.
Sub Example()
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R9C2", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Sheet4!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Sheet4").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("item1")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("sub12")
.Orientation = xlRowField
.Position = 2
End With
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
your old worksheet is called yourWorksheet.
create a new worksheet:
set newWS = thisworkbook.workbooks.add()
dim rr as long
rr =1
for r = startRow to yourWorksheet.UsedRange.Rows.Count
firstItem = yourWorksheet.cells(r,1).value
newWS.cells(rr,1).value = firstItem
rr = rr + 1
do while firstItem = yourworksheet.cells(r,1).value
newWS.cells(rr,1).value = yourworksheet.cells(rr,2).value 'copy all columns here
rr = rr + 1
r =r + 1
loop
next r
rough and untested, but that's the idea.
If you use the left command and extract the Item One, Item Two, etc.
Heading(row) = Left(Cells(row,"B"), 8)
then extract the subItem:
SubItem(row) = Left(Right(cells(row, "B"), 20), 10)
These will extract the text.
You have to get creative for THREE and FOUR.
Sub Sort1()
'
' Sort1 Macro
' Macro recorded 7/30/2012 by American International Group
'
'
Dim r As Integer
Dim c As Integer
Dim lr2 As Integer
Dim a As String
Dim b As String
Dim cdb As Long
Dim name1 As String
Dim name2 As String
n1 = InputBox(Prompt:="Enter a name for worksheet else click OK", Title:="Enter a name for this sheet", Default:="owssvr")
n2 = InputBox(Prompt:="Enter a name for the Report view sheet else click OK", Title:="Enter a name for Report sheet", Default:="reportView")
b = InputBox(Prompt:="Enter Column Name on which to sort data", Title:="Sort by", Default:="B")
b = UCase(b) 'convert to uppercase e.g.c to C
asciiCol = Asc(b) 'convert to ascii 66
asciiNext = asciiCol + 1 'add one to ascii to get next column ascii code e.g. 66+1=67 to get D
sortbyColNo = 0
sortbyColNo = Range(b & "1").Column
'Rename sheets to avoid conflict
Sheets(1).name = n1
Sheets("" & n1 & "").Select
r = Range("a65536").End(xlUp).Row
c = Range("IU1").End(xlToLeft).Column
a = Split(Cells(, c).Address, "$")(1)
x = Split(Cells(, c).Address, "$")(2)
MsgBox "last row with data is " & r & " and last column with data is " & a & "", vbOKOnly, "LastRow and LastCol"
rr = r + 1
'Application.Visible = False
Range("A1:" & a & r & "").Sort Key1:=Range("" & b & "2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("" & n1 & "").Select
Sheets.Add
ActiveSheet.name = n2
'by default select first record and paste in reports sheet
Sheets("" & n1 & "").Select
Range("" & b & "2").Select
Selection.Copy
Sheets("" & n2 & "").Select
Range("b2").Select
ActiveSheet.Paste
'paste header below it
Sheets("" & n1 & "").Select
Range("" & Chr(asciiNext) & "1:" & a & "1").Select
With Selection
.Font.Bold = True
End With
Range("" & Chr(asciiNext) & "1:" & a & "2").Select
Selection.Copy
Sheets("" & n2 & "").Select
Range("b3").Select
ActiveSheet.Paste
'start from row 3
For i = 3 To r
Sheets("" & n1 & "").Select
'Program name is same as above, dont copy name but row starting from next col, switch to other sheet, find last row in col B, add one to last row and paste
If Cells(i, sortbyColNo).Value = Cells(i - 1, sortbyColNo) Then
Range("" & Chr(asciiNext) & "" & i & ":" & a & i & "").Select
Selection.Copy
Sheets("" & n2 & "").Select
'Range("b3").Select
lr2 = Range("b65536").End(xlUp).Row
Range("B" & lr2 + 1 & "").Select
ActiveSheet.Paste
Else
'if name is not same as above, copy name, find last row, add two to add a gap from prev program name, paste program name, move to next row and paste remaining cols
Sheets("" & n1 & "").Select
Range("" & b & "" & i & "").Select
Selection.Copy
Sheets("" & n2 & "").Select
lr2 = Range("b65536").End(xlUp).Row
Range("B" & lr2 + 2 & "").Select
ActiveSheet.Paste
'copy headers
Sheets("" & n1 & "").Select
Range("" & Chr(asciiNext) & "1:" & a & "1").Select
Selection.Copy
Sheets("" & n2 & "").Select
lr2 = Range("b65536").End(xlUp).Row
Range("B" & lr2 + 1 & "").Select
ActiveSheet.Paste
'copy cells(row, col+1)
Sheets("" & n1 & "").Select
Range("" & Chr(asciiNext) & i & ":" & a & i & "").Select
Selection.Copy
Sheets("" & n2 & "").Select
'Range("b3").Select
lr2 = Range("b65536").End(xlUp).Row
Range("B" & lr2 + 1 & "").Select
ActiveSheet.Paste
End If
Next
'Application.Visible = True
'formatSheet
End Sub