I have 2 wb and need to copy value to another wb based on condition:
If the value in the column F of wb2 appears in column F of wb1, then I need to copy value in the column G of wb2 to column G of wb1. The code is below:
Dim LtRow As Long
Dim m As Long, n As Long
With wb2.Worksheets.Item(1)
LtRow = .Cells(.Rows.Count, "G").End(xlUp).Row
End With
With ThisWorkbook.Sheets.Item(2)
n = .Cells(.Rows.Count, "G").End(xlUp).Row + 1
End With
For m = 1 To LtRow
With wb2.Worksheets.Item(1)
If .Cells(m, 6).Value = ThisWorkbook.Sheets.Item(2).Cells(m, 6).Value Then
.Rows(m).Copy Destination:=ThisWorkbook.Sheets.Item(2).Range("G" & n)
n = n + 1
End If
End With
Next m
I don't know why the code didn't work at all! Where is the problem in my code?
EDIT:
To see what your excel files look like wasn't an option for what you are trying to do. Especially because in you have many empty rows. Anyway, this works for me:
Sub CopyConditions()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Wb1Ws2 As Worksheet
Dim Wb2Ws1 As Worksheet
Set Wb1 = ThisWorkbook
Set Wb1Ws2 = ThisWorkbook.Sheets("Differences")
'open the wb2
Dim FullFilePathAndName As Variant
Dim StrOpenFileTypesDrpBx As String
Let StrOpenFileTypesDrpBx = "xls (*.xls),*.xls,CSV (*.CSV),*.CSV,Excel (*.xlsx),*.xlsx,OpenOffice (*.ods),*.ods,All Files (*.*),*.*,ExcelMacros (*.xlsm),.xlsm"
Let FullFilePathAndName = Application.GetOpenFilename(StrOpenFileTypesDrpBx, 1, "Compare this workbook ""(" & Wb1.Name & ")"" to...?", , False) 'All optional Arguments
If FullFilePathAndName = False Then
MsgBox "You did't select a file!", vbExclamation, "Canceled"
Exit Sub
Else
Set Wb2 = Workbooks.Open(FullFilePathAndName)
Set Wb2Ws1 = Wb2.Sheets("Sheet1")
End If
Dim rCell As Range
Dim sCell As Range
'loop through each cell in column F until row30 because with the empty cells in the column we can't use Rows.count
For Each rCell In Wb1Ws2.Range(Wb1Ws2.Cells(1, 6), Wb1Ws2.Cells(30, 6)) 'Wb1Ws2.Cells(Wb1Ws2.Rows.Count, 6).End(xlUp))
'if the cell column F is equal to a cell in wb2 sheet1 column L
For Each sCell In Wb2Ws1.Range(Wb2Ws1.Cells(3, 12), Wb2Ws1.Cells(Wb2Ws1.Rows.Count, 12).End(xlUp))
If sCell = rCell Then
rCell.Offset(0, 1) = sCell.Offset(0, 1)
End If
Next sCell
Next rCell
End Sub
How does it go for you?
Related
I am struggling to figure out how to get the code to do what I want, I wrote as much as I could with what I could find online, but for some aspects, I don't know what write.
Purpose of the code
Check "spreadsheet 2017" for the number "1" next to each name. If there is a "1", then enter values in multiple cells in a row in another workbook called "Dates template" (in the same row as name in "spreadsheet 2017")
Details on what I would like it to do
Column A and B has list first name (A), and surname (B)
Check through column C for "1", next to the names
If there is a 1, then switch to workbook "Dates Template"
find the same name in column A, and put the values 7.2 (col B), 3.9 (col C) and 74.2 (col D).
This is the basic backbone of the code, in the future I will be looking to add additional conditions, such as 1 in column D for example as well 1 in column C. so maybe a case function would work better, then it would be easier to add in the future. I don't know which is better.
In the code below I only wrote it to scan through the surnames in column B, because there are no duplicates. but in the future, it is likely that there will be names with the same surname, in which case first name will have to be read as well. This is where I'm confused on how to check both.
A bonus would be if its possible to copy the list of names over to the "Dates template" and then input those values if the criteria is met. Because at the moment I manually type up the names onto the "Date Template" Spreadsheet.
Sub Summary()
Dim wb1 As Workbook
Dim Sht As Worksheet
Dim Rng As Range
Dim wb2 As Workbook
Dim cell As Range
Dim ws As Worksheet
Set wb1 = Workbooks("Works template.xlsm")
Set wb2 = Workbooks("Spreadsheet 2017")
Set Sht = wb1.Worksheets("Template")
Set ws = wb2.Worksheets("January")
Set Rng = ws.Range("B7:B" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row)
For Each cell In Rng
If cell.Offset(0, 2).Value = "1" Then
Sht.Cells.Offset(0, 3).Value = "7.2" '<--- This is where I get the new error, "Application-defined or object-defined error"
Sht.Cells.Offset(0, 2).Value = "3.9"
Sht.Cells.Offset(0, 6).Value = "74.2"
End If
Next
End Sub
Thanks a lot!
Sht.Cells refers to all cells in the sheet, so you can't use .Offset() on this.
Sub Summary()
Dim wb1 As Workbook
Dim Sht As Worksheet
Dim Rng As Range
Dim wb2 As Workbook
Dim cell As Range
Dim ws As Worksheet
Set wb1 = Workbooks("Works template.xlsm")
Set wb2 = Workbooks("Spreadsheet 2017")
Set Sht = wb1.Worksheets("Template")
Set ws = wb2.Worksheets("January")
Set Rng = ws.Range("B7:B" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row)
For Each cell In Rng
If cell.Offset(0, 1).Value = "1" Then
sht.Range(cell.address).Offset(-2, 0).Offset(0, 0).Value = "7.2"
sht.Range(cell.address).Offset(-2, 0).Offset(0, 1).Value = "3.9"
sht.Range(cell.address).Offset(-2, 0).Offset(0, 2).Value = "74.2"
End If
Next
End Sub
Sub Insertdata()
Dim iAge As Integer
Set src = Workbooks.Open("age.xlsm", True, True)
t = 2
lastrow = ActiveSheet.UsedRange.Rows.Count
Do Until t = lastrow
iAge = src.Worksheets("Sheet1").Range("B" & t).Value
ThisWorkbook.Worksheets("Sheet1").Range("B" & t).Value = iAge
t = t + 1
Loop
End Sub
the same program how do we return not listing but connnected date with key
How do we remake the program to copy one value
I want to copy a table into a new Workbook while choosing which range I want to copy and knowing that the first Columns ("A") is automatically copied. (rows are not a problem, all of them have to be copied)
For example, i have a table composed of 28 rows and 10 columns. Added to A1:A28 (first columns, all rows),i want just to copy the column 5 and 8 with all its rows.
That's what i have until now but it doesn't work.
Sub CommandButton1_Click()
Dim newWB As Workbook, currentWB As Workbook
Dim newS As Worksheet, currentS As Worksheet
Dim CurrCols As Variant
Dim rng As rang
'Copy the data you need
Set currentWB = ThisWorkbook
Set currentS = currentWB.Sheets("Feuil1")
'select which columns you want to copy
CurrCols = InputBox("Select which column you want to copy from table (up to 10)")
If Not IsNumeric(CurrCols) Then
MsgBox "Please select a valid Numeric value !", vbCritical
End
Else
CurrCols = CLng(CurrCols)
End If
'Set rng = currentWB.currentS.Range(Cells(1, A), Cells(27, CurrCols)).Select
currentS.Range("A1:A27").Select
Selection.copy
Set rng = currentWB.currentS.Range(Cells(1, CurrCols), Cells(28, CurrCols)).Select
rng.copy
'Create a new file that will receive the data
Set newWB = Workbooks.Add
With newWB
Set newS = newWB.Sheets("Feuil1")
newS.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
End Sub
Can you help please solving it? Thanks in advance!
You can't copy a non-continuous range but you can load the data into an array and write it once to the new workbook.
Private Sub CommandButton1_Click()
Dim arData
Dim MyColumns As Range, Column As Range
Dim x As Long, y As Long
On Error Resume Next
Set MyColumns = Application.InputBox(Prompt:="Hold down [Ctrl] and click the columns to copy", Title:="Copy Columns to new Workbook", Type:=8)
On Error GoTo 0
If MyColumns Is Nothing Then Exit Sub
Set MyColumns = Union(Columns("A"), MyColumns.EntireColumn)
Set MyColumns = Intersect(MyColumns, ActiveSheet.UsedRange)
ReDim arData(1 To MyColumns.Rows.Count, 1 To 1)
For Each Column In MyColumns.Columns
y = y + 1
If y > 1 Then ReDim Preserve arData(1 To MyColumns.Rows.Count, 1 To y)
For x = 1 To Column.Rows.Count
arData(x, y) = Column.Rows(x)
Next
Next
With Workbooks.Add().Worksheets(1)
.Range("A1").Resize(UBound(arData, 1), UBound(arData, 2)) = arData
.Columns.AutoFit
End With
End Sub
try this (commented) code
Option Explicit
Sub CommandButton1_Click()
Dim newSht As Worksheet
Dim currCols As String
Dim area As Range
Dim iArea As Long
Set newSht = Workbooks.add.Worksheets("Feuil1") '<--| add a new workbook and set its "Feuil1" worksheet as 'newSht'
currCols = Replace(Application.InputBox("Select which column you want to copy from table (up to 10)", "Copy Columns", "A,B,F", , , , , 2), " ", "") '<--| get columns list
With ThisWorkbook.Worksheets("Feuil1") '<--| reference worksheet "Feuil1" in the workbook this macro resides in
For Each area In Intersect(.Range(ColumnsAddress(currCols)), .Range("A1:G28")).Areas ' loop through referenced worksheet areas of the range obtained by crossing its listed columns with its range "A1:G28"
With area '<--| reference current area
newSht.Range("A1").Offset(, iArea).Resize(.Rows.Count, .Columns.Count).value = .value '<--| copy its values in 'newSht' current column offset from "A1" cell
iArea = iArea + .Columns.Count '<--| update current column offset from 'newSht' worksheet "A1" cell
End With
Next area
End With
End Sub
Function ColumnsAddress(strng As String) As String
Dim elem As Variant
For Each elem In Split(strng, ",")
ColumnsAddress = ColumnsAddress & elem & ":" & elem & ","
Next
ColumnsAddress = Left(ColumnsAddress, Len(ColumnsAddress) - 1)
End Function
I think you can copy all column to a temp sheet and then write some code to delete the useless column. finally paste the table to your expected area.
I'm having trouble with the code below.
I'm trying to use the values from column "A" in wb2 to search in column "G" in wb1.
Column "A" in wb2 contains a long list of numbers and I'm trying to search a exact match of that number in column "G" in wb1.
When there's a match I need it to set the value of column "AF" at the correct row in wb2 to the corresponding match from wb1, but from another column, maybe column "Z" instead of "G".
The to workbooks are already open, when running the macro.
Hope you can help me out.
Thanks in advance.
Sub ROAC()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet
Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set sht = wb2.Worksheets("oversigt")
LastRow = sht.Cells(sht.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = wb1.Sheets("Period").Range(wb1.Sheets("Period").Range("G1"), wb1.Sheets("Period").Range("G1").End(xlDown)).Rows.Count
LastRowWb2 = wb2.Sheets("Oversigt").Range(wb2.Sheets("Oversigt").Range("A1"), wb2.Sheets("Oversigt").Range("A1").End(xlDown)).Rows.Count
For y = 7 To LastRowWb1
For x = 1 To LastRowWb2
If wb1.Sheets("Period").Range("G" & y).Value = wb2.Sheets("Oversigt").Range("A" & x).Value Then
wb2.Sheets("Oversigt").Range("AF" & LastRow).Offset(1, 0).Value = wb1.Sheets("Period").Range("G" & y)
End If
Next x
Next y
End Sub
Here's how I would look to carry out your requirement (assuming I understood it clearly enough anyway!). This code loops through all rows in column A in wb2, and performs a Find operation against column G in wb1. Where it's found, it sets AF column in wb2 for that row to be the value from wb1's Z column on the same row.
Sub ROAC()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet
Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set wb1sht = wb1.Worksheets("Period")
Set wb2sht = wb2.Worksheets("oversigt")
LastRowWb1 = wb1sht.Cells(wb1sht.Rows.Count, "G").End(xlUp).Row
LastRowWb2 = wb2sht.Cells(wb2sht.Rows.Count, "A").End(xlUp).Row
For y = 1 To LastRowWb2
findMe = wb2sht.Range("A" & y).Value
With wb1sht.Range("G7:G" & LastRowWb1)
Set oFound = .Find(findMe)
If Not oFound Is Nothing Then
' Found number - set AF in wb2 on this row to Z on the same row from wb1
wb2sht.Range("AF" & oFound.Row).Value = wb1sht.Range("Z" & oFound.Row).Value
Else
' Didn't find number, so do whatever you might need to do to handle this in here...
End If
End With
Next
End Sub
This should fix your issue ( I've not wrote this in VBA so there might be the odd syntax issue).
Essentially, you can 'Find' your value in wb1 and if its there paste that value into wb2.
Sub ROAC()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim y As Integer
Dim sht As Worksheet
Dim fndRange as Range
Dim wb1Value as variant
Set wb1 = Workbooks("EP_BB_DK_ny.xlsm")
Set wb2 = Workbooks("Laaneoversigt.xlsm")
Set sht = wb2.Worksheets("oversigt")
LastRow = sht.Cells(sht.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = wb2.Sheets("Period").Range("G" & Rows.Count).End(xlUp).Row
LastRowWb2 = wb2.Sheets("Oversigt").Range("A" & Rows.Count).End(xlUp).Row
For y = 7 To LastRowWb1
wb1Value = wb1.Sheets("Period").Range("G" & y).Value
Set fndRange = wb2.Sheets("Oversigt").Range("A1:A" & LastRowWb2).Find(What:= wb1Value)
If Not fndRange is Nothing Then
wb2.Sheets("Oversigt").Range("AF" & LastRow).Offset(1, 0).Value = wb1.Sheets("Period").Range("G" & fndRange.Row)
End If
Next y
End Sub
Sub ROAC()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Target_Data As Range
Dim y As Integer
'Since you were using same sheets over and over, I just set ws1 and ws2
'instead of writing Wb1.Sheets("Period") wb2.Sheets("Oversigt") everytime
Set ws1 = Workbooks("EP_BB_DK_ny.xlsm").SHEETS("Period")
Set ws2 = Workbooks("Laaneoversigt.xlsm").SHEETS("Oversigt")
lastrow = ws2.Cells(ws2.Rows.Count, "AF").End(xlUp).Row
LastRowWb1 = ws1.Range(ws1.Range("G1"), ws1.Range("G1").End(xlDown)).Rows.Count
For y = 7 To LastRowWb1
''''This compares ws1.Range("G" & y) with ws2.Column A and set Target_Data as matching range
Set Target_Data = ws2.Columns("A").Find(ws1.Range("G" & y).Value)
''''This check if the Target_data found data or not (Find method will return Nothing if it doesn't find it.)
If Not (Target_Data Is Nothing) Then
''''''''This will write ws1. Column Z's data to ws2. Column AF on same row as where the data is found
ws2.Range("AF" & Target_Data.Row) = ws1.Range("Z" & y)
End If
Next y
End Sub
I might be little off on getting source data and target data.
It's really confusing
Anyway, You can play around with it to make it work :)
I need to copy the same worksheet X times (x = sheet2 row A) into a new workbook.
For each copy I need to:
1.Change a drop down to display the next value
2.Do a Refresh (Workbook is connected to a database which pulls different information based on the value of the drop down and is not automatically refreshed)
3.Copy just the values (no formulas)
Rename the sheet to the value of the drop down.
Save all of the copied worksheets into 1 workbook
My code (below) which is called on a button press currently saves the sheet X times based on sheet2 rowA (as intended).
It is missing steps 1,2,4 and 5
The code I have at the moment (called on button click)
Dim x As Integer '~~>Loop counter
Dim WS As Worksheet
Dim LastCellA As Range, LastCellB As Range
Dim LastCellRowNumber As Long
Set WS = Worksheets("Sheet2") '~~>Sheet with names
With WS
Set LastCellA = .Cells(.Rows.Count, "A").End(xlUp) '~~>Column with names.
'~~>This needs to be changed to find the range as data may not start at A1
x = Application.WorksheetFunction.Max(LastCellA.Row)
End With
For numtimes = 1 To x
ActiveWorkbook.Sheets("Sheet1").Copy _
After:=ActiveWorkbook.Sheets(Worksheets.Count)
'~~>Copy values only
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
Next
Still... I'm not sure of the point that you "Import" different values based on a drop down. That may be a different macro for loding the data. Then you need to call that macro instead of the .RefreshAll.
Sub test()
Dim uRow As Long, lRow As Long, i As Long
Dim wb As Workbook, ws As Object
With ThisWorkbook
Set ws = .Sheets("Sheet2")
With ws
uRow = .Cells(.Rows.Count, "A").End(xlUp).End(xlUp).Row
lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Set wb = Workbooks.Add
For i = uRow To lRow
.Sheets("Sheet1").Range("M1").Value = ws.Cells(i, 1).Value '<~~~ this should change the dropdown
Calculate
.RefreshAll
.Sheets("Sheet1").Copy , wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Name = ws.Cells(i, 1).Value
Next
Application.DisplayAlerts = False
wb.Sheets(1).Delete
Application.DisplayAlerts = True
For Each ws In wb.Sheets
ws.UsedRange.Value = ws.UsedRange.Value
Next
End With
End Sub
EDIT:
If you get trouble with the Sheet2 Column A List (cus it contains empty cells resulting of formulas) you may try a different approach:
Sub test()
Dim wb As Workbook, ws As Worksheet
Dim xVal As Variant
With ThisWorkbook
Set ws = .Sheets("Sheet2")
Set wb = Workbooks.Add
For Each xVal In Intersect(ws.Range("A:A"), ws.UsedRange).Value
If Len(xVal) Then
.Sheets("Sheet1").Range("M1").Value = xVal
Calculate
.RefreshAll
.Sheets("Sheet1").Copy , wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Name = ws.Cells(i, 1).Value
wb.Sheets(wb.Sheets.Count).UsedRange.Value = wb.Sheets(wb.Sheets.Count).UsedRange.Value
End If
Next
Application.DisplayAlerts = False
wb.Sheets(1).Delete
Application.DisplayAlerts = True
End With
End Sub
Based on the code you provided, I believe this is what you are looking for.
It will loop through your list, copy sheet1 to the new workbook and name the sheet.
I am not sure what you want with looping through your dropdown list.
Sub Button1_Click()
Dim wb As Workbook, Bk As Workbook
Dim WS As Worksheet, sh As Worksheet
Dim LastCellA As Long, LastCellB As Range, c As Range
Dim LastCellRowNumber As Long
Dim x As Integer '~~>Loop counter
Set wb = ThisWorkbook
Set WS = wb.Worksheets("Sheet2") '~~>Sheet with names
Set sh = wb.Sheets("Sheet1")
With WS
LastCellA = .Cells(.Rows.Count, "A").End(xlUp).Row '~~>Column with names.
'~~>This needs to be changed to find the range as data may not start at A1
Set LastCellB = .Range("A1:A" & LastCellA).SpecialCells(xlCellTypeConstants, 23)
End With
Set Bk = Workbooks.Add
For Each c In LastCellB.Cells
sh.Range("M1") = c
sh.Copy After:=Bk.Sheets(Worksheets.Count)
With ActiveSheet
'~~>Copy values only
.UsedRange.Value = .UsedRange.Value
.Name = c
End With
Next c
End Sub
I'm a portuguese engineer and I've recently started programming in Visual Basic on a button from a specific Worksheet named "Início" on a Workbook named by "Livro MQTEN". On the Worksheet "Início" I have one button with the following code:
Private Sub CommandButton1_Click()
Dim lngCount As Long
Dim j As String
Dim fileName As String
Dim lngIndex As Long
Dim strPath() As String
Dim nome As String
Dim folha As String
' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.Title = "Selecione o ficheiro dos comboios realizados do dia"
.InitialFileName = "Explor. *"
.AllowMultiSelect = False
.Show
.Filters.Add "Excel files", "*.xlsx; *.xls", 1
' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
'MsgBox .SelectedItems(lngCount)
j = .SelectedItems(lngCount)
'MsgBox (j)
strPath() = Split(j, "\") 'Put the Parts of our path into an array
lngIndex = UBound(strPath)
fileName = strPath(lngIndex) 'Get the File Name from our array
'MsgBox (fileName)
nome = fileName
'Get name of sheet
Dim wb As Workbook
Dim ws As Worksheet
Dim TxtRng As Range
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Início")
ws.Unprotect
Set TxtRng = ws.Range("D17")
TxtRng.Value = nome
ws.Protect
folha = Cells.Item(21, 6)
'MsgBox (folha)
'Copy from sheet
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim SrcRange As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set x = Workbooks.Open(j)
Set y = ThisWorkbook
Set ws1 = x.Sheets(folha)
Set ws2 = y.Sheets("Explor. do Mês")
Set CopyData = ws1.Range("A1:M8000").EntireColumn
CopyData.Copy
Set Addme = ws2.Range("A1:M8000")
Addme.PasteSpecial xlPasteValues
x.Close True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Next lngCount
End With
End Sub
In the code:
Set CopyData = ws1.Range("A1:M8000").EntireColumn
CopyData.Copy
Set Addme = ws2.Range("A1:M8000")
Addme.PasteSpecial xlPasteValues
I paste the entire column from column A to column M. I need to Copy and PasteSpecial only the cells from the worksheet ws1 that have values to the worksheet ws2. Then if I click again in the button and select another Workbook add the values to ws2 and not overwrite them. How can I do this in Visual Basic? What I'm missing here? Please guys, I really, really need your help! Thanks in advance.
SOLVED!
Just changed the code above to:
With ws2
'Presuming the column "A" in ws2 will always contain the last row.
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
'Because we determine the last used row based on this column in ws2 (intLastRow)
ws1.Range("A1:M8000").Copy
.Cells(intLastRow + 1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
And added in the variables declaration this:
Dim intLastRow As Integer
Change the copy code with this :
Dim intLastRow As Integer 'put it where you declare variables.
'Maybe use long, if data on ws2 can exceed 32K rows or something like that.
With ws2
'Presuming the column "A" in ws2 will always contain the last row.
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
'Because we determine the last used row based on this column in ws2 (intLastRow)
.Range(.Cells(intLastRow + 1, 1), .Cells(intLastRow + 1, 13)) = ws1.Range("A1:M8000").Value
End With
Edit 1
Ammended the code based on comment from OP. Now with the correct Range("A1:M8000") and Cells(intLastRow + 1, 13)
Edit 2
With ws2
'Presuming the column "A" in ws2 will always contain the last row.
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
'Because we determine the last used row based on this column in ws2 (intLastRow)
ws1.Range("A1:M8000").Copy
.Cells(intLastRow + 1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
You can try to use "For" method to read each cells individually
The code below will copy from sheet1 only if the cell is not empty and will only paste if the cell in sheet2 is not filled
'this one will run each row
For i = 1 to 8000
'this one will run each collumn
For j = 1 to 13
If ws1.cells(i,j) <> "" then
ws1.cells(i,j).copy
if ws2.cells(i,j) = "" then
ws2.cells(i,j).PasteSpecial xlPasteValues
Else:
cutcopymode=false
End if
End if
Next
Next