Thanks for reading my questions.
I have a table [ws1(A4:Q500)] contains data, while there are formula after column Q. Therefore I cannot copy the whole row but only certain range in text.
Column Q is the formula to define whether the data falls into period, i.e. 16/11-30/11 data. The flag is as follows:
0 < 16/11
1 = 16/11 - 30/11
2 > 30/11
Here the goal is to copy ws1 data with flag "1" to [ws2(A2:P200)]
And then delete ws1 data with flag "1" and "2"
Believe that the rules for copying and deleting is quite similar, I tried to do the copy parts first
Sub PlotGraph()
Dim i As Integer
Dim j As Integer
Dim lastrow As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Analysis")
j = 2
lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lastrow
If ws1.Cells(i, 17) = 1 Then
ws1.Range(Cells(i, 1), Cells(i, 16)).Copy
ws2.Range(Cells(j, 1), Cells(j, 16)).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
j = j + 1
End If
Next i
End Sub
The debug functions said its wrong in
ws1.Range(Cells(i, 1), Cells(i, 16)).Copy
I tried hard to do modifications but it stills not work, please help me a bit :( Thanks so much.
The ws2.Range(Cells(j, 1), Cells(j, 16)).PasteSpecial does not adequately reference the range as belonging to ws2. The Cells(...) within the range could belong to any worksheet; they have to specifically belong to ws2. The same goes for ws1.
ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 16)).Copy
ws2.Range(ws2.Cells(j, 1), ws2.Cells(j, 16)).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
An AutoFilter Method may save you some time with a bulk value transfer.
Sub PlotGraph()
Dim i As Long, j As Long, lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Data")
Set ws2 = ThisWorkbook.Sheets("Analysis")
j = 2
With ws1
lr = .Cells(Rows.Count, 1).End(xlUp).Row
With .Range(.Cells(3, 1), .Cells(lr, 17)) 'Range(A3:Q & lr) need header row for autofilter
.AutoFilter field:=17, Criteria1:=1
With .Resize(.Rows.Count - 1, 16).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.Cells.Copy _
Destination:=ws2.Cells(j, 1)
'optional Copy/PasteSpecial xlPasteValues method
'.Cells.Copy
'ws2.Cells(j, 1).PasteSpecial Paste:=xlPasteValues
'▲ might want to locate row j properly instead of just calling it 2
End If
End With
End With
End With
End Sub
I noticed you are using a Range.PasteSpecial method with xlPasteValues. If you require value-only transfer, then that can be accommodated.
Related
I have a lot of different workbooks that have multiple tabs that I need to extract data from to summarise. Unfortunately they are all in columns so each data point is in its own column with the categories in rows down to 50.
I need to be able to copy all of the used columns bar column A in each sheet into an output sheet named "Samples". So for each new tab I need the data to be pasted to the next available column in the output sheet.
The following is the code that I have written but on the second loop I get an object defined error.
Can anyone point me in the right direction? I'm pretty new to all this!
Sub ExtractSamples()
Set wsOutput = ActiveWorkbook.Sheets("Samples")
For Each wsInput In ActiveWorkbook.Worksheets
If wsInput.Name <> wsOutput.Name Then
With wsInput
LColI = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rng = .Range(.Cells(1, 2) & .Cells(50, LColI))
rng.Copy
With wsOutput
LColO = .Range("A" & .Columns.Count).End(xlToLeft).Column + 1
.Range("A" & LColO).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End With
End If
Next wsInput
End Sub
Thanks so much!
Try this. I've corrected the syntax as above (your assignation of LColO didn't make sense because A is a column and range wants a row and a column). I have also declared all your variables, which is good practice even if it probably didn't cause an error in this instance.
Sub ExtractSamples()
Dim wsOutput As Worksheet, wsInput As Worksheet
Dim LColI As Long, LColO As Long
Set wsOutput = ActiveWorkbook.Sheets("Samples")
For Each wsInput In ActiveWorkbook.Worksheets
If wsInput.Name <> wsOutput.Name Then
With wsInput
LColI = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set Rng = .Range(.Cells(1, 2), .Cells(50, LColI))
Rng.Copy
With wsOutput
LColO = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
.Cells(1, LColO).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End With
End If
Next wsInput
End Sub
I have a column of IDs in an Excel worksheet called Sheet1. I have data that corresponds to the IDs in columns to the right of Column A. The amount of cells in a row varies. For example:
A, B, C, D, E, F, ...
John, 5, 10, 15, 20
Jacob, 2, 3
Jingleheimmer, 5, 10, 11
I'm trying to copy that data into a new worksheet, Sheet5, in the following format:
A, B, C, D, E, F, ...
John, 5
John, 10
John, 15
John, 20
Jacob, 2
Jacob, 3
Jingleheimmer, 5
Jingleheimmer, 10
Jingleheimmer, 11
I wrote the following code that copies over the first two IDs. I could continue to copy paste the second half of the code and just change the cells, however, I have 100s of IDs. This would take too long. I think whenever a process is repeated I should be using a loop. Can you help me turn this repetitive code into a loop?
Sub Macro5()
Dim LastRowA As Integer
Dim LastRowB As Integer
''' Process of copying over first ID '''
'grab all data cells in B2 to the right
With Sheets("Sheet1").Select
Range("B2", Range("B2").End(xlToRight)).Select
Selection.Copy
End With
'paste that data into the first empty cell of Column B in Sheet5
With Sheets("Sheet5").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End With
'grab the corresponding ID in cell A2
With Sheets("Sheet1").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
End With
'paste the corresponding ID into the first empty cell of Column A in Sheet5
With Sheets("Sheet5").Select
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A1:A" & LastRowB)
End With
''' Repeat that process for each row in Sheet1 '''
'grab all data cells in B3 to the right
With Sheets("Sheet1").Select
Range("B3", Range("B3").End(xlToRight)).Select
Selection.Copy
End With
'paste that data into the first empty cell of Column B in Sheet5
With Sheets("Sheet5").Select
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & LastRowB + 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End With
'grab the corresponding ID in cell A3
With Sheets("Sheet1").Select
Range("A3").Select
Application.CutCopyMode = False
Selection.Copy
End With
'paste the corresponding ID into the first empty cell of column A in Sheet5
'and autofill down to the last populated cell in column B
With Sheets("Sheet5").Select
LastRowA = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & LastRowB + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Selection.AutoFill Destination:=Range("A" & LastRowA & ":A" & LastRowB)
End With
End Sub
Try this:
Sub test()
Dim i As Integer
Dim j As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim nRow As Integer
Dim lRow As Integer
Dim lCol As Integer
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet5")
nRow = 1
With ws1
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To lRow
lCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
For j = 2 To lCol
ws2.Cells(nRow, 1).Value = .Cells(i, 1).Value
ws2.Cells(nRow, 2).Value = .Cells(i, j).Value
nRow = nRow + 1
Next j
Next i
End With
End Sub
It runs through each row in the sheet one at a time, copying over the names and associated numbers up through the last column with values in that row. Should work very quickly and doesn't require constant copy & pasting.
This should do what you're looking for.
Sub test()
Dim lastrow As Long, lastcol As Long
Dim i As Integer, j as Integer, x as Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet5")
lastrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
x = 1
With ws1
For i = 1 To lastrow
lastcol = .Cells(i, .Columns.Count).End(xlToLeft).Column
For j = 2 To lastcol
ws2.Cells(x, 1).Value = .Cells(i, 1).Value
ws2.Cells(x, 2).Value = .Cells(i, j).Value
x = x + 1
Next j
Next i
End With
End Sub
I want to build a table on one Excel Sheet "Ship" by pulling data from another excel sheet "Efficiency." The row data on the "Efficiency" sheet is categorized by "Shipped", "Leave", "Import" and "Export".
Each category (shipped, leave, import, export) has several items and they're in no specific order. The table on the "Efficiency" sheet occupies columns A:H, and starts at row 2; the length can vary.
I want to be able to search the rows for "Shipped" and copy columns A, D:F and H of the matching rows and paste them beginning at cell B4 of the "Ship" sheet. Can anyone help me please?
Sub Ship()
ActiveSheet.Range("$A$1:$H$201").AutoFilter Field:=4, Criteria1:="Shipped"
' this is looking in a specific range, I want to make it more dynamic
Range("A4:A109").Select
'This is the range selected to copy, again I want to make this part more dynamic
Application.CutCopyMode = False
Selection.Copy
Range("A4:A109,D4:F109,H4:H109").Select
Range("G4").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Ship").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
This code has been tested based on your the information as given in your question:
Sub Ship()
Dim wsEff As Worksheet
Dim wsShip As Worksheet
Set wsEff = Worksheets("Efficiency")
Set wsShip = Worksheets("Shipped")
With wsEff
Dim lRow As Long
'make it dynamic by always finding last row with data
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'changed field to 2 based on your above comment that Shipped is in column B (the code you posted has 4).
.Range("A1:H" & lRow).AutoFilter Field:=2, Criteria1:="Shipped"
Dim rngCopy As Range
'only columns A, D:F, H
Set rngCopy = Union(.Columns("A"), .Columns("D:F"), .Columns("H"))
'filtered rows, not including header row - assumes row 1 is headers
Set rngCopy = Intersect(rngCopy, .Range("A1:H" & lRow), .Range("A1:H" & lRow).Offset(1)).SpecialCells(xlCellTypeVisible)
rngCopy.Copy
End With
wsShip.Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
try the below code
Sub runthiscode()
Worksheets("Efficiency").Select
lastrow = Range("A" & Rows.Count).End(xlUp).Row
startingrow = 4
For i = 2 To lastrow
If Cells(i, 2) = "Shipped" Then
cella = Cells(i, 1)
celld = Cells(i, 4)
celle = Cells(i, 5)
cellf = Cells(i, 6)
cellh = Cells(i, 8)
Worksheets("Ship").Cells(startingrow, 2) = cella
Worksheets("Ship").Cells(startingrow, 5) = celld
Worksheets("Ship").Cells(startingrow, 6) = celle
Worksheets("Ship").Cells(startingrow, 7) = cellf
Worksheets("Ship").Cells(startingrow, 9) = cellh
startingrow = startingrow + 1
End If
Next i
End Sub
Since hours now I'm struggling with the same problem now...
I try to copy certain rows upon a condition in column A to an other Workbook. I don't get an error message, the code runs through, but nothing happens. Somehow it seems not to "see" the lines between Then and End If. If I run the code manually, the line directly jumps to End if and further repeats the loop.
Do you have any idea what could be wrong? - Thanks for any help!
This part of my code lookes like:
Dim LastRow As Integer, i As Integer
LastRow = Workbooks("Workb1.xlsx").Sheets("Sheet1").Cells(Rows.Count,"A").End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 2).Value = "848" Then
Range(Cells(i, 2), Cells(i, 14)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Paste
End If
Next i
After your first comments, the edited code now is:
Dim LastRow As Integer, i As Integer
Dim ws4 As Worksheet
Set ws4 = Workbooks("Workb1").Sheets("Sheet1")
LastRow = ws4.Cells(Rows.Count, "A").End(xlUp).Row
With ws4
For i = 1 To LastRow
If .Cells(i, 1).Value = 848 Then
Range(.Cells(i, 1)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Paste
End If
Next i
End With
Ok, What I actually want to do:
Always copy from source to target sheet
First only for rows, which have a 848 in column A and paste them to target. So for all those rows, which have an 848 in column A:
Copy value in the column X in “source” --> Column Y in “target”
A --> A N-->B O-->C AM -->D AH -->G P-->I E-->J F-->K
Now, only consider those cells with a 618 in column A and copy/paste, again to the firs empty cell in this column (so after the rows with 848, now the target-sheet gets completed with the 618 cells.
A --> A N-->B O-->C AM -->D T -->G P-->I E-->J F-->K
Column E and F in the target: there are formula, which have to be elongated to the end of the column
I did change that much until now, that it's not even a working code anymore...
Private Sub CommandButton1_Click()
Dim LastRow As Integer, i As Integer, erow As Integer, LastRow2 As Integer
Dim ws4 As Worksheet
Set ws4 = Workbooks("macro_source").Sheets("Sheet1")
LastRow = ws4.Cells(Rows.Count, "A").End(xlUp).Row
With ws4
For i = 2 To LastRow
If .Cells(i, 1).Value = 848 Then
Workbooks("macro_source").Sheets("Sheet1").Activate
.Cells(i, 1).Copy
Set erow = Workbooks("destination.xlsx").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
End If
Next i
End With
End Sub
Maybe I have to add, that both files are pre-edited by the prior code, which I did not show here. And I still did not find out whether it's possible to upload the data as excel files...
Many thanks for your help again, I really stuck...
copying between books seems to go wrong fairly often even when what you have coded seems to logically be correct.
I have found in the past it's better to reference the sheet then use the reference and to use the with statement as it seems to handle range selections better
Some code below should work for you... (I have altered the paste to start at A1 and increment each time as the original code would overwrite each time it found a value - you should be able to edit to paste where you want)
Sub CopyToNewBook()
On Error Resume Next
Dim wbSrc As Workbook: Set wbSrc = Workbooks("Workb1.xlsx")
Dim wbDest As Workbook: Set wbDest = Workbooks("destination.xlsx")
If wbSrc Is Nothing Or wbDest Is Nothing Then
MsgBox "Please open both workbooks required"
Exit Sub
End If
On Error GoTo 0
Dim wsSrc As Worksheet: Set wsSrc = wbSrc.Sheets("Sheet1")
Dim wsDest As Worksheet: Set wsDest = wbDest.Sheets("Sheet1")
Dim LastRow As Long, i As Long, j As Long: j = 63976
With wsSrc
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 2 To LastRow
If .Cells(i, 1).Value = "848" Then
.Range(.Cells(i, 2), .Cells(i, 14)).Copy
wsDest.Range("A" & j).PasteSpecial xlPasteValues
j = j + 1
End If
Next i
End With
End Sub
UPDATE
For searching against multiple values
Sub CopyToNewBook()
On Error Resume Next
Dim wbSrc As Workbook: Set wbSrc = Workbooks("Workb1.xlsx")
Dim wbDest As Workbook: Set wbDest = Workbooks("destination.xlsx")
If wbSrc Is Nothing Or wbDest Is Nothing Then
MsgBox "Please open both workbooks required"
Exit Sub
End If
On Error GoTo 0
Dim SearchValues() As String: SearchValues = Split("848,618", ",")
Dim wsSrc As Worksheet: Set wsSrc = wbSrc.Sheets("Sheet1")
Dim wsDest As Worksheet: Set wsDest = wbDest.Sheets("Sheet1")
Dim LastRow As Long, i As Long, j As Long, z As Long: z = 63976
With wsSrc
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For j = 0 To UBound(SearchValues)
For i = 2 To LastRow
If .Cells(i, 1).Value = SearchValues(j) Then
.Range(.Cells(i, 2), .Cells(i, 14)).Copy
wsDest.Range("A" & z).PasteSpecial xlPasteValues
z = z + 1
End If
Next i
Next j
End With
End Sub
To add to my comment
you're also counting the number of rows in column A and running the loop on column B. I'd also set your cells as it could be looking at the wrong sheet
Dim LastRow As Integer, i As Integer
Dim ws as worksheet
set ws = Workbooks("Workb1.xlsx").Sheets("Sheet1")
LastRow = ws.Cells(Rows.Count,"B").End(xlUp).Row
with ws
For i = 2 To LastRow
If .Cells(i, 2).Value = 848 Then
Range(.Cells(i, 2), .Cells(i, 14)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Paste
End If
Next i
end with
Update:
you could simplify a lot of this
Dim LastRow As Integer, i As Integer
Dim ws as worksheet
set ws = Workbooks("Workb1.xlsx").Sheets("Sheet1")
LastRow = ws.Cells(Rows.Count,"B").End(xlUp).Row
with ws
For i = 2 To LastRow
If Trim(Val(.Cells(i, 1))) = 848 Then
Range(.Cells(i, 2)).Copy _
destination:=Workbooks("destination.xlsx") _
.Worksheets("Sheet1").Range("A63976").Paste
End If
Next i
end with
This code will work fine. Check your cell that has 848 in it manually and make sure it is an integer.
Try this:
Dim LastRow As Integer, i As Integer
Dim ws4 As Worksheet
Set ws4 = Workbooks("Workb1.xlsx").Sheets("Sheet1")
LastRow = ws4.Cells(Rows.Count, "A").End(xlUp).Row
With ws4.Columns(1)
For i = 1 To LastRow
If .Cells(i).Value = 848 Then
Range(.Cells(i, 2), .Cells(i, 14)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Select
Selection.PasteSpecial
End If
Next i
End With
EDIT:
Ok, I'm sure this is frowned upon, but this is how I would have solved the issue. It's nothing close to pro-code, but it gets the work done.
Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = 848 Then
Range(ActiveCell.Offset(0, 1).Address(False, False), ActiveCell.Offset(0, 14).Address(False, False)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Select
Selection.PasteSpecial
End If
ActiveCell.Offset(1, 0).Select
Loop
If this code does not work, there's something else that's fishy. The code needs to be executed in the worksheet containing the list, which should be placed in column A and contain no blanks.
You can always change which sheet is selected by adding code.
This should be simple but I am having a tough time.. I want to copy the cells A3 through E3, and paste them into the next empty row on a different worksheet. I have used this code before in longer strings of code.. but i had to tweak it and it is not working this time. I get a "application-defined or object-defined error" when i run the code seen below. All help is appreciated.
Private Sub CommandButton1_Click()
Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).row
Range("A3:E3").Copy Destination:=Sheets("Summary Info").Range("A:A" & lastrow)
End Sub
Be careful with the "Range(...)" without first qualifying a Worksheet because it will use the currently Active worksheet to make the copy from. It's best to fully qualify both sheets. Please give this a shot (please change "Sheet1" with the copy worksheet):
EDIT: edited for pasting values only based on comments below.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet2")
copySheet.Range("A3:E3").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
The reason the code isn't working is because lastrow is measured from whatever sheet is currently active, and "A:A500" (or other number) is not a valid range reference.
Private Sub CommandButton1_Click()
Dim lastrow As Long
lastrow = Sheets("Summary Info").Range("A65536").End(xlUp).Row ' or + 1
Range("A3:E3").Copy Destination:=Sheets("Summary Info").Range("A" & lastrow)
End Sub
You could also try this
Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("A3:E3").Copy
Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).Row
Sheets("Summary Info").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Below is the code that works well but my values overlap in sheet "Final" everytime the condition of <=11 meets in sheet "Calculator"
I would like you to kindly support me to modify the code so that the cursor should move to next blank cell and values keeps on adding up like a list.
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Calculator")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Final")
For i = 2 To ws1.Range("A65536").End(xlUp).Row
If ws1.Cells(i, 4) <= 11 Then
ws2.Cells(i, 1).Value = Left(Worksheets("Calculator").Cells(i, 1).Value, Len(Worksheets("Calculator").Cells(i, 1).Value) - 0)
ws2.Cells(i, 2) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:D"), 4, False)
ws2.Cells(i, 3) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:E"), 5, False)
ws2.Cells(i, 4) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:B"), 2, False)
ws2.Cells(i, 5) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:C"), 3, False)
End If
Next i