I want to copy the data one excel to another excel
My question:
In the one workbook Sheet1 column C & D contains some data that data i need to copy another excel that's in closed condition presently. I need to copy Range("C" , i) and Range("D" , i) in to another excel sheet3 B2 and C2 accordingly. in that mainthing each rows copy paste into different workbooks i given a path in H Columns
Sub sbCopyRangeToAnotherSheet()
Dim Openfile As String
Dim lstrow As Long
Dim i As Long
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lstrow
'Copy the data
Sheets("Main").Range("C:D", i).Copy
'Activate the destination worksheet
Workbook.Openfile = Range("H", i)
Sheets("Sheet3").Activate
'Select the target range
Range("B2:C2").Select
'Paste in the target destination
ActiveSheet.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Next
End Sub
Error Screenshot
Related
I am in the process of trying to create a Macro so that we can press a button and it updates the whole sheet.
Essentially all my data is being collected from another workbook, but it has to be non macro hence all my data is pulling through to my sheet Do Not Delete.
I have got my Macro to cycle through and copy/paste as values onto another sheet and remove all the rows that contain the text '#VALUE!'.
I have tried searching around on how to do this, but to no avail. I am trying to find out how to search each row on the 'Do Not Delete' sheet for the value that is in Column G on each row for anywhere that this exists elsewhere in the workbook, but I am unable to do this. From the point that I find the last record where it exists, I want to then copy down from there onwards.
Sub CopyToSheet()
'
' CopyToSheet Macro
Dim wb As Workbook
Dim ws, wscopy, wsdnd As Worksheet
Dim i, LastRowa, LastRowd As Long
Dim WSheet As String
Dim SheetName As String
Set wsdnd = Sheets("Do Not Delete")
Set wscopy = Sheets("CopyAndClear")
Set wb = ActiveWorkbook
Set ws = ActiveWorkbook.Sheets("Macro - Do not delete")
'Finding Sheet to use
SheetName = Range("L2")
Debug.Print Range("L2")
'Clear Contents
wscopy.Activate
wscopy.Cells.Clear
'Activating Do Not Delete Sheet to copy the data
wsdnd.Activate
LastRowa = wsdnd.Cells(Rows.Count, "A").End(xlUp).Row
wsdnd.Range("A1:IP" & LastRowa).Select
wsdnd.Range("A1:IP" & LastRowa).Copy
'Copy and paste cells onto new sheet
wscopy.Activate
wscopy.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Apply Filter
Application.DisplayAlerts = False
LastRowc = wscopy.Cells(Rows.Count, "A").End(xlUp).Row
wscopy.Range("A1:IP" & LastRowc).AutoFilter Field:=1, Criteria1:="#VALUE!"
'Delete Rows
wscopy.Range("A1:IP" & LastRowc).SpecialCells(xlCellTypeVisible).Delete
'Clear Filter
On Error Resume Next
wscopy.ShowAllData
On Error GoTo 0
End Sub
Sub Start()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("1")
Set ws2 = Sheets("2")
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, "D").End(xlUp).row
For i = 1 To LastRow
ws1.Range("D" & i).copy
ws2.Range("A2").PasteSpecial Paste:=xlPasteFormats
Next i
If ws1.Range("A" & i) = vbNullString Then
Exit Sub
End If
End Sub
I'm trying to make it so this code pastes the interior fill from column D, Into Column A, unless there is already interior fill present.
Any input appreciated.
Edit: I'm trying to copy the format (interior fill) from Sheet 1 and Sheet 2's Column A's (until the last row) and paste it to Sheet Column A. I'm trying to copy over once cell at a time, and ignore if there is already fill present in sheet 3, because my I dont want the format from sheets 1 and 2 to overwrite eachtoher.
I have an excel sheet named as "Task" which contains two tabs "Data" and "DB-Task". I want to copy data from sheet "Data" to "DB-Task". Sheet "Data" has five columns (e.g. A,B,C,D,E,F). I want that if some one enter data in first row it should be transferred to another tab. If any of the columns is not filled it should give a popup to enter values before transferring data to another sheet . And In case the second row has all data it should get transferred to another sheet and only give error for first row .
I am using below code for copying data and it is successfully copying data from one sheet to another . Now I am not sure how should I use if condition effectively so that I can achieve what I want
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Dim endrow As Long
Set sheet1 = ActiveWorkbook.Sheets("Data")
Set sheet2 = ActiveWorkbook.Sheets("Delivery Task")
Application.ScreenUpdating = False
endrow = sheet2.Range("A" & sheet2.Rows.Count).End(xlUp).Row
sheet1.Range("A2:E10").Copy
sheet2.Activate
sheet2.Range("A" & endrow + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
sheet1.Activate
Range("A2:E10").ClearContents
End Sub
Eventhough I am new to VBA Let me help.You can use this sub to check if all the columns are filled for a particular row and based on the value of column 8 you can copy and transfer file
FindEmptyCells()
Dim colnum As Long
Dim rownum As Long
Dim lastrow As Long
lastrow = Sheets("Data").Range("A" & Rows.count).End(xlUp).Row
For rownum = 1 To lastrow
For colnum = 1 To 5
If IsEmpty(Cells(rownum, colnum)) Then '<== To Check for Empty Cells
Cells(rownum, 8) = "Data Incomplete" '<== To Enter value if empty cell found
Else
Cells(rownum, 8) = "OK"
End If
Next colnum
Next rownum
End Sub
I'm trying to write a macro to copy the contents of cell A1 of sheet wsVN to the first open cell in column F of sheet wsVL, then copy A2 to the next open cell in F, then A3 to the next and so on up to A305. Sheet VL has a header row with the first open cell being F2. That's where I'm trying to past A1. Then I have a couple rows with data then another open cell where I'd like to past A2. Then 5 rows of data before the next open cell where A3 should go. Here is as close as I have made it so far:
Sub Data_Transfer()
'
' Data_Transfer Macro
' Transfers VariableNames Data to the next available row of sheet VariableList.
Dim lastRow As Integer
Dim wsVN As Worksheet
Dim wsVL As Worksheet
Dim sourceRange As Range
Dim targetRange As Range
Set wsVN = Worksheets("VariableNames")
Set wsVL = Worksheets("VariationList")
If Len(wsVL.Range("F1").Value) > 0 Then
lastRow = wsVL.Range("F2").End(xlDown).Row
Else
lastRow = 2
End If
Set sourceRange = wsVN.Range("A1")
Set targetRange = wsVL.Range("F" & lastRow).Offset(1, 0)
sourceRange.Copy
targetRange.PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Hopefully someone will offer some guidance on this. It would be appreciated very much!
Thanks
Try this, adjusting sheet names to suit.
Sub x()
Dim r As Range
With Worksheets("Sheet1") 'source sheet
For Each r In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
Worksheets("Sheet2").Range("F:F").SpecialCells(xlCellTypeBlanks)(1).Value = r.Value 'destination sheet
Next r
End With
End Sub
More on SpecialCells.
My destination workbook (wb1) is a table with a range of A1:Q740 and has a header row, the data workbook (wb2) that I want to copy from always has the same columns A:Q with the number of rows varying.
In both workbooks, the data in columns A:F for most, but not all rows is identical. I would like to compare those columns in both worksheets, and if a given row in A:F matches the other workbook, copy the data from that row for columns G:Q from the data workbook to the row with matching data in the destination workbook.
My issue is most of the time the rows between the two workbooks don't line up. For example, in both workbooks cells A2:F2 match. However, the farther down the workbook you go the rows diverge. In the data workbook, cells A153:F153 are the same as the destination workbook cells A159:F159. So, in this example I would like my code to copy data from cells G2:Q2 and G153:Q153 and paste them to the destination workbook in cells G2:Q2 and G159:Q159, respectively.
I've got my workbooks, worksheets and ranges named, but I'm not sure how best to run the comparison or how to code the copy/paste destination correctly.
EDIT: Updated code as below, it works until row 34 and then breaks since the matching data is no longer in the same row number in each workbook.
Option Explicit
Sub MergeWorksheets()
Dim wb1 As Workbook '2017 Tracking Report
Dim wb2 As Workbook 'Book# Drake Export from CSM
Dim Drake17 As Worksheet
Dim ImportDataFull As Range 'Full Range of Drake17 Export, less header row
Dim lastRow As Long 'Last Row of Drake17 Worksheet
Dim lastRow2 As Long 'Last Row of Drake Export
Dim ImportData As Range 'Drake Export Data
Dim DesImportData As Range 'Destination Range of Data for Compare
Dim DesImportRange As Range 'Destination for ImportRange
Set wb1 = Workbooks("2017 Tracking Report.xlsm")
Set wb2 = Workbooks(Workbooks.Count) 'Sets the most recently opened WB
Set Drake17 = wb1.Sheets("Drake17")
lastRow = Drake17.Range("A" & Rows.Count).End(xlUp).Row
Set DesImportData = Drake17.Range("A1:F" & lastRow)
Set DesImportRange = Drake17.Range("G1:Q" & lastRow)
wb2.Activate
lastRow2 = Range("A" & Rows.Count).End(xlUp).Row
Set ImportDataFull = Range("A1:Q" & lastRow2) 'Full Data Export Less Header Row
Set ImportData = Range("A1:F" & lastRow2) 'Sets range of data to compare
Dim r As Range
Dim i As Integer
With Columns(6)
.NumberFormat = "m/d/yyy"
.Value = .Value
End With
With Columns(2)
.NumberFormat = "General"
.Value = .Value
End With
Application.ScreenUpdating = False
For i = 2 To lastRow2
With ImportDataFull
Set r = Range("G" & i, "Q" & i)
If ImportData.Cells(i, 1) = DesImportData.Cells(i, 1) And _
ImportData.Cells(i, 2) = DesImportData.Cells(i, 2) And _
ImportData.Cells(i, 3) = DesImportData.Cells(i, 3) And _
ImportData.Cells(i, 4) = DesImportData.Cells(i, 4) And _
ImportData.Cells(i, 5) = DesImportData.Cells(i, 5) And _
ImportData.Cells(i, 6) = DesImportData.Cells(i, 6) Then
r.Copy DesImportRange.Rows(i)
r.EntireRow.HorizontalAlignment = xlCenter
End If
End With
Next i
Application.ScreenUpdating = True
End Sub