PDA

View Full Version : [SOLVED:] Offset Rows


jammer6_9
08-16-2021, 01:12 AM
I am trying to copy cell values in multiple workbook (same range) however the first capture is over written by the second capture.
Any help on offsetting rows?


With wsTarget
'***** First Data capture ******
.Range("B" & rowTarget).Value = wsSource.Range("E63").Value
.Range("C" & rowTarget).Value = wsSource.Range("G63").Value
.Range("D" & rowTarget).Value = wsSource.Range("H63").Value
.Range("E" & rowTarget).Value = wsSource.Range("I63").Value
.Range("F" & rowTarget).Value = wsSource.Range("J63").Value
.Range("G" & rowTarget).Value = wsSource.Range("K63").Value
.Range("M" & rowTarget).Value = wsSource.Range("L63").Value
.Range("H" & rowTarget).Value = wsSource.Range("M63").Value
.Range("I" & rowTarget).Value = wsSource.Range("N63").Value
.Range("J" & rowTarget).Value = wsSource.Range("O63").Value
.Range("K" & rowTarget).Value = wsSource.Range("P63").Value
.Range("L" & rowTarget).Value = wsSource.Range("Q63").Value
.Range("M" & rowTarget).Value = wsSource.Range("R63").Value
.Range("N" & rowTarget).Value = wsSource.Range("S63").Value

'***** Second Data capture ******
.Range("B" & rowTarget).Value = wsSource.Range("E64").Value
.Range("C" & rowTarget).Value = wsSource.Range("G64").Value
.Range("D" & rowTarget).Value = wsSource.Range("H64").Value
.Range("E" & rowTarget).Value = wsSource.Range("I64").Value
.Range("F" & rowTarget).Value = wsSource.Range("J64").Value
.Range("G" & rowTarget).Value = wsSource.Range("K64").Value
.Range("M" & rowTarget).Value = wsSource.Range("L64").Value
.Range("H" & rowTarget).Value = wsSource.Range("M64").Value
.Range("I" & rowTarget).Value = wsSource.Range("N64").Value
.Range("J" & rowTarget).Value = wsSource.Range("O64").Value
.Range("K" & rowTarget).Value = wsSource.Range("P64").Value
.Range("L" & rowTarget).Value = wsSource.Range("Q64").Value
.Range("M" & rowTarget).Value = wsSource.Range("R64").Value
.Range("N" & rowTarget).Value = wsSource.Range("S64").Value


.Range("A" & rowTarget).Value = Range("e4").Value

End With
rollis13
08-16-2021, 03:18 AM
Move your last row of code before:

'***** Second Data capture ******and then add this code:
rowTarget = rowTarget + 1like this:
'...
.Range("L" & rowTarget).Value = wsSource.Range("Q63").Value
.Range("M" & rowTarget).Value = wsSource.Range("R63").Value
.Range("N" & rowTarget).Value = wsSource.Range("S63").Value
.Range("A" & rowTarget).Value = Range("E4").Value '<- moved up
rowTarget = rowTarget + 1 '<- added
'***** Second Data capture ******
.Range("B" & rowTarget).Value = wsSource.Range("E64").Value
.Range("C" & rowTarget).Value = wsSource.Range("G64").Value
.Range("D" & rowTarget).Value = wsSource.Range("H64").Value
.Range("E" & rowTarget).Value = wsSource.Range("I64").Value
'...
jammer6_9
08-16-2021, 04:29 AM
Actually I had that code with the below full code.


Sub ImportWorksheets()
Dim sFile As String
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long

rowTarget = 2



If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If


On Error GoTo errHandler
Application.ScreenUpdating = False


Set wsTarget = Sheets("Database")



sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""



Set wbSource = Workbooks.Open(FOLDER_PATH & sFile, UpdateLinks:=False)
Set wsSource = wbSource.Worksheets(1)



With wsTarget

'***** First Data Range capture ******
.Range("B" & rowTarget).Value = wsSource.Range("E63").Value
.Range("C" & rowTarget).Value = wsSource.Range("G63").Value
.Range("D" & rowTarget).Value = wsSource.Range("H63").Value
.Range("E" & rowTarget).Value = wsSource.Range("I63").Value
.Range("F" & rowTarget).Value = wsSource.Range("J63").Value
.Range("G" & rowTarget).Value = wsSource.Range("K63").Value
.Range("M" & rowTarget).Value = wsSource.Range("L63").Value
.Range("H" & rowTarget).Value = wsSource.Range("M63").Value
.Range("I" & rowTarget).Value = wsSource.Range("N63").Value
.Range("J" & rowTarget).Value = wsSource.Range("O63").Value
.Range("K" & rowTarget).Value = wsSource.Range("P63").Value
.Range("L" & rowTarget).Value = wsSource.Range("Q63").Value
.Range("M" & rowTarget).Value = wsSource.Range("R63").Value
.Range("N" & rowTarget).Value = wsSource.Range("S63").Value

'***** Second Data Range capture ******
.Range("B" & rowTarget).Value = wsSource.Range("E64").Value
.Range("C" & rowTarget).Value = wsSource.Range("G64").Value
.Range("D" & rowTarget).Value = wsSource.Range("H64").Value
.Range("E" & rowTarget).Value = wsSource.Range("I64").Value
.Range("F" & rowTarget).Value = wsSource.Range("J64").Value
.Range("G" & rowTarget).Value = wsSource.Range("K64").Value
.Range("M" & rowTarget).Value = wsSource.Range("L64").Value
.Range("H" & rowTarget).Value = wsSource.Range("M64").Value
.Range("I" & rowTarget).Value = wsSource.Range("N64").Value
.Range("J" & rowTarget).Value = wsSource.Range("O64").Value
.Range("K" & rowTarget).Value = wsSource.Range("P64").Value
.Range("L" & rowTarget).Value = wsSource.Range("Q64").Value
.Range("M" & rowTarget).Value = wsSource.Range("R64").Value
.Range("N" & rowTarget).Value = wsSource.Range("S64").Value




.Range("A" & rowTarget).Value = Range("e4").Value

End With


wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop

errHandler:
On Error Resume Next
Application.ScreenUpdating = True


Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing

End Sub





Move your last row of code before:

'***** Second Data capture ******and then add this code:
rowTarget = rowTarget + 1like this:
'...
.Range("L" & rowTarget).Value = wsSource.Range("Q63").Value
.Range("M" & rowTarget).Value = wsSource.Range("R63").Value
.Range("N" & rowTarget).Value = wsSource.Range("S63").Value
.Range("A" & rowTarget).Value = Range("E4").Value '<- moved up
rowTarget = rowTarget + 1 '<- added
'***** Second Data capture ******
.Range("B" & rowTarget).Value = wsSource.Range("E64").Value
.Range("C" & rowTarget).Value = wsSource.Range("G64").Value
.Range("D" & rowTarget).Value = wsSource.Range("H64").Value
.Range("E" & rowTarget).Value = wsSource.Range("I64").Value
'...
jammer6_9
08-16-2021, 04:44 AM
Got it. Thanks! That works. :hi:


Move your last row of code before:

'***** Second Data capture ******and then add this code:
rowTarget = rowTarget + 1like this:
'...
.Range("L" & rowTarget).Value = wsSource.Range("Q63").Value
.Range("M" & rowTarget).Value = wsSource.Range("R63").Value
.Range("N" & rowTarget).Value = wsSource.Range("S63").Value
.Range("A" & rowTarget).Value = Range("E4").Value '<- moved up
rowTarget = rowTarget + 1 '<- added
'***** Second Data capture ******
.Range("B" & rowTarget).Value = wsSource.Range("E64").Value
.Range("C" & rowTarget).Value = wsSource.Range("G64").Value
.Range("D" & rowTarget).Value = wsSource.Range("H64").Value
.Range("E" & rowTarget).Value = wsSource.Range("I64").Value
'...
rollis13
08-16-2021, 06:06 AM
Glad I was able to help :thumb.