I have the below code, which works fine but it is copying the formulas and cell formatting not just the values. could anyone tell me how to obtain just the values?
Option Explicit
Sub MoveQuick()
Dim sh As Worksheet
Dim ws As Worksheet
Set sh = Sheets("Sheet1")
Set ws = Sheets("Sheet2")
ws.[a2:o2000].ClearContents
sh.Range("B8", sh.Range("S" & Rows.Count).End(xlUp)).AutoFilter 1, "MTU"
sh.Range("D9", sh.Range("I" & Rows.Count).End(xlUp)).Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
sh.Range("T9", sh.Range("V" & Rows.Count).End(xlUp)).Copy ws.Range("H" & Rows.Count).End(xlUp)(2)
sh.[B8].AutoFilter
End Sub
This code will work for you.
sh.Range("D9", sh.Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
ws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Related
I have been trying to loop through a range of cells and apply an index match . So, far, the index match is working only for the first row of the range (so its not looping). I am providing the code.
Dim LastRow As Long
Sheets("REPORT").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("C2:C" & LastRow).Formula "=INDEX('2609'!C:C,MATCH('REPORT'!A2,'2609'!E:E,FALSE))"
Write
Range("C2:C" & LastRow).Formula "=INDEX('2609'!C:C,MATCH('REPORT'!A2,'2609'!E:E,FALSE))"
as
Range("C2:C" & LastRow).Formula ="=INDEX('2609'!C:C,MATCH('REPORT'!A2,'2609'!E:E,FALSE))"
you are missing = sign.
Your code can be written as
Sub Demo()
Dim ws As Worksheet
Dim LastRow As Long
Set ws = ThisWorkbook.Sheets("REPORT")
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("C2:C" & LastRow).Formula = "=INDEX('2609'!C:C,MATCH('REPORT'!A2,'2609'!E:E,FALSE))"
End With
End Sub
I am attempting to copy column A starting in row 2 on "Sheet1" and paste it in Column C on sheet "ABC" starting at row 5. The number of rows in Column A is variable so I cannot use a fixed range.
The code below does what I need, but I am trying to avoid using .Select and .Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("A2:A" & LastRow).Copy
Sheets("ABC").Activate
Sheets("ABC").Range("C5:C" & LastRow).Select
Selection.PasteSpecial xlPasteValues
I tried setting the columns equal to one another using this code:
Sheets("ABC").Range("C5").End(xlDown).Value=Sheets("Sheet1").Range("A2:A" & LastRow).Value
This runs without error but it "does nothing" -- No data appears on worksheet "ABC"
I also tried to following:
Dim WS As Worksheet
Dim wsABC As worksheet
Set WS = Sheets("Sheet1")
Set wsABC = Sheets("ABC")
LastRow = Range("A" & Rows.Count).End(xlUp).Row
WS.Range("A2:A" & LastRow).Copy
wsABC.Range("C5").End(xlDown).Paste
This produces a "Run-time error #438 Object doesn't support this property or method" Error on this line:
wsABC.Range("C5").End(xlDown).Paste
Another method I tried was as follows:
Dim WS As Worksheet
Set WS = Sheets("Sheet1")
Set wsABC = Sheets("ABC")
With WS
LastRow = Range("A" & Rows.Count).End(xlUp).Row
WS.Range("A2:A" & LastRow).value = wsABC.Range("C5:C & LastRow").Value
End With
This produces a "Run-time error '1004' Application-defined or object defined error.
I am open to corrections / comments on any of my attempts, I just want to avoid using .Select and .Activate.
Thank you in advance for your time and assistance!
Coding styles can vary greatly. Here's one way to do what you're looking for:
Sub tgr()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsDest As Worksheet
Set wb = ActiveWorkbook
Set wsData = wb.Sheets("Sheet1")
Set wsDest = wb.Sheets("ABC")
With wsData.Range("A2", wsData.Cells(wsData.Rows.Count, "A").End(xlUp))
wsDest.Range("C5").Resize(.Rows.Count).Value = .Value
End With
End Sub
With Worksheets("Sheet 1")
With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
Worksheets("ABC").Range("C5").Resize(.Rows.Count).Value = .Value
End With
End With
I am trying to transfer data from one workbook to another. Workbook A has 48 tabs of different data and I have 48 excel files that I need to copy-paste to specific columns. the tab name and file names are matching so that is why I set the names range. I keep getting syntax error from the open statement (set y)
and another error at the ws1-select-range line. would you help me to under stand what I am doing wrong?
Sub Transfer()
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim names As String
Set x = ThisWorkbook
For a = 2 To 49
names = ThisWorkbook.Sheets(1).Range("A" & a).Text
' getting compile error: Expected end of statement
set y = workbook.Open Filename:=Thisworkbook.Path & "/" & names & ".xlsx"
Set ws1 = x.Sheets(names)
Set ws2 = y.Sheets("Equipment")
'updated code as below then getting run time error '1004': Copy method of range class failed
ws1.Range("B2:B200").Copy ws2.Range("A3")
ws1.Range("c2:c200").Copy ws2.Range("B3")
ws1.Range("f2:f200").Copy ws2.Range("C3")
ws1.Range("g2:g200").Copy ws2.Range("D3")
Next a
End Sub
I appreciate your time and advice.
So I updated some code and I kind of make it work. :)
Sub Transfer()
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim names As String
Dim lastrow As Integer
Dim a As Integer
Set x = ThisWorkbook
For a = 2 To 49
names = ThisWorkbook.Sheets(1).Range("A" & a).Text
Set y = Workbooks.Open("C:\Documents\Work\" & names & ".xlsx")
Set ws1 = x.Sheets(names)
Set ws2 = y.Sheets(2)
lastrow = ws1.Cells(Rows.Count, 6).End(xlUp).Row
ws1.Range("B2:B" & lastrow).Copy ws2.Range("A3")
ws1.Range("C2:C" & lastrow).Copy ws2.Range("B3")
ws1.Range("F2:F" & lastrow).Copy ws2.Range("C3")
ws1.Range("G2:G" & lastrow).Copy ws2.Range("D3")
ws1.Range("H2:H" & lastrow).Copy ws2.Range("E3")
ws1.Range("I2:I" & lastrow).Copy ws2.Range("F3")
ws1.Range("J2:J" & lastrow).Copy ws2.Range("G3")
ws1.Range("L2:L" & lastrow).Copy ws2.Range("H3")
ws1.Range("M2:M" & lastrow).Copy ws2.Range("I3")
ws1.Range("N2:N" & lastrow).Copy ws2.Range("J3")
ws1.Range("O2:O" & lastrow).Copy ws2.Range("K3")
y.Save
y.Close
Next a
End Sub
I've never used VBA before, I don't know the commands and stuff. I really trying and I need some help please. I've to copy only the visible data from specified columns and paste to another worksheet, but I receive Subscript out of range error, while running the code. In the code I've to select the rows from the 7th row and I think I coded this a bit rough. Can anyone check my code why is this not working? Any suggestions for a better solution is appreciated.
Sub CopyData()
Windows("Source.xlsx").Activate
Range("D7, F7, G7, I7, J7, K7, L7, M7, O7, AD7, AX7, CO7, CQ7, CR7, AX7").Select
Range(Selection, Selection.End(xlDown)).Select
If Selection.EntireColumn.Hidden = False Then
Selection.Copy
End If
Windows("Destination.xlsx").Activate
Range("A2").Select
ActiveSheet.Paste
End Sub
Give this a shot:
Sub CopyData()
'set variables for wkb and ws to copy
Dim wbSource As Workbook
Set wbSource = Workbooks("Source.xlsx")
Dim wsCopy As Worksheet
Set wsCopy = wbSource.Worksheets("Sheet1") 'change name as needed
'set variables for wkb and ws to paste
Dim wbDest As Workbook
Set wbDest = Workbooks("Destination.xlsx")
Dim wsDest As Worksheet
Set wsDest = wbDest.Worksheets("Sheet1")
'copy visible cells for specific range
With wsCopy
Dim lRow As Long
lRow = .Range("D" & .Rows.Count).End(xlUp).Row
Dim rCopy As Range
Set rCopy = Union(.Range("D7:D" & lRow), .Range("F7:F" & lRow), _
.Range("G7:G" & lRow), .Range("I7:I" & lRow), .Range("J7:J" & lRow), _
.Range("K7:K" & lRow), .Range("L7:L" & lRow), .Range("M7:M" & lRow), _
.Range("O7:O" & lRow), .Range("AD7:AD" & lRow), .Range("AX7:AX" & lRow), _
.Range("CO7:CO" & lRow), .Range("CQ7:CQ" & lRow), .Range("CR7:CR" & lRow))
End With
'paste
rCopy.SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A2")
End Sub
Dim rng As Range
Set rng = Application.Intersect(ActiveSheet.UsedRange, Range("A1:H500"))'range depends your work
Windows("Destination.xlsx").Activate
rng.SpecialCells(xlCellTypeVisible).Copy Destination:=Range("A2")
or you just use,
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
without intersection method. Totally depends on your work.
I have a copy / paste loop for line items in an Excel file that exports data from these line items into an Excel-based form and saves each form by the value in Row B. My issue is that these line items are divided into 3 different tables on the same sheet, each with a different number of line items to be copied. Furthermore, each table is separated by 2 blank rows.
What I need the macro to do for me:
Start at line 17 and copy all line items in the first table until it hits a blank row - this varies from 1 to 600 rows.
Skip to SecondTable and perform the same functions.
Repeat for ThirdTable
Ignore some of the declarations as I deleted a large chunk of code for readability. I figured I would need 3 separate copy/paste loops to accomplish this (I've only included 2 here) and I tried using .Find to reference the start of the second/third tables. The macro runs as normal through the first table, but doesn't stop when it hits a blank row and fails when it tries to save a file based on the value of an empty cell. I believe the issue lies with the EndOne = .Range("B" & .Rows.Count).End(xlUp).Row argument right under With wsSource. Instead of counting only the non-blank rows of the first table, it counts the number of rows through the end of the third table.
Sub CopyToForm()
Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath As String
Dim EndOne As Long, EndTwo As Long, EndThree As Long, i As Integer
Dim strProcessingFormPath As String
'Dim strCancel As String
'Dim strFilt As String
'Dim intFilterIndex As Integer
'Dim strDialogueFileTitle As String
Dim SecondTable As String
Dim ThirdTable As String
Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name
With wsSource
'~~> Counts how many rows are in the Indication Tool
EndOne = .Range("B" & .Rows.Count).End(xlUp).Row
If EndOne < 17 Then MsgBox "No data for transfer": Exit Sub
For i = 17 To EndOne
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
'.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the value in cell i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
With wsSource
SecondTable = .Range("B:B").Find("SecondTable").Row
EndTwo = .Range("B" & .Rows.Count).End(xlUp).Row
For i = Second Table + 1 To EndTwo
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the cells i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub
Am I on the right track with the .Find and a separate copy/paste loop for each table? I realize this is a complex problem and I appreciate any time you take to spend helping me out.
Am I on the right track with the .Find and a separate copy/paste loop for each table?
Not exactly. The code inside those loops is largely the same, so it is a good candidate for subroutine. This will make your code more human-readable, and also makes it easier to maintain since there will only be one place to make revisions, instead of multiple (imagine if you needed to do 10 different iterations, or 1,000 -- you wouldn't possibly write 1,000 different loops to do the same thing!!)
Consider this instead (I observe a few obvious errors which I will correct, but this is not tested). What I have done is to take your several loops, and consolidate them in to a single subroutine. Then we send some information like where the table starts and where it ends, to that subroutine:
Sub CopyStuff(ws as Worksheet, tblStart as Long, tblEnd as Long)
We will send it: wsSource, and the other variables will be used/re-used to determine the start/end of each table. I removed the redundant variables (unless they need to be re-used elsewhere, having two variables EndOne and EndTwo is unnecessary: we can make use of more generic variables like tblStart and tblEnd which we can reassign for subsequent tables.
In this way it is a lot more apparent that we are processing multiple tables in an identical manner. We also have only a single For i = ... loop to manage, should the code require changes in the future. So it is easier to comprehend, and easier to maintain.
Sub CopyToForm()
Dim wbSource As Workbook 'No longer needed in this context: wbForm As Workbook
Dim wsSource As Worksheet 'No longer needed in this context: wsForm As Worksheet
Dim formpath As String, foldertosavepath As String
Dim tblEnd As Long, tblStart As Long, i As Integer
Dim strProcessingFormPath As String
Dim tblStart as Integer: tblStart = 16
Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name
With wsSource
'~~> Counts how many rows are in the Indication Tool
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
If tblEnd < 17 Then GoTo EarlyExit '## I like to use only one exit point from my subroutines/functions
CopyStuff wsSource, tblStart, tblEnd
tblStart = .Range("B:B").Find("SecondTable").Row + 1
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
CopyStuff wsSource, tblStart, tblEnd
'And presumably...
tblStart = .Range("B:B").Find("ThirdTable").Row + 1
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
CopyStuff wsSource, tblStart, tblEnd
End With
Exit Sub
EarlyExit:
MsgBox "No data for transfer"
End Sub
Private Sub CopyStuff(ws As Worksheet, tblStart as Long, tblEnd as Long)
Dim wbForm as Workbook, wsForm as Worksheet, i As Long
With ws
For i = tblStart to tblEnd
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
'.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the value in cell i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub