Jan 11 2021 02:48 AM - edited Jan 11 2021 02:49 AM
hallo. ich benutze folgende Script um monatlich meine Datei zusammenzumergen. das funktioniert prima, nur Die Spalten Überschrift wird mehrmals importiert und meine erste zeile ist immer leer.
Sub AddAllWS()
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim lLastRow As Long
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wbDst = ThisWorkbook
MyPath = "...\DqExcels\MergTickets\"
strFilename = Dir(MyPath & "*.xls*", vbNormal)
Do While strFilename <> ""
Set wbsrc=Workbooks.Open(MyPath & strFilename)
'loop through each worksheet in the source file
For Each wsSrc In wbSrc.Worksheets
'Find the corresponding worksheet in the destination with the same name as the source
On Error Resume Next
Set wsDst = wbDst.Worksheets(wsSrc.Name)
On Error GoTo 0
If wsDst.Name = wsSrc.Name Then
lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1
wsSrc.UsedRange.Copy
wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues
End If
Next wsSrc
wbSrc.Close False
strFilename = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
kann mir jemand bitte helfen!
Lg Boldrino
Jan 11 2021 03:30 PM
Solution@LBoldrino I'm not going to create multiple workbooks to test and hope I get it right...
Try replacing the 3 lines inside your IF statement with this:
lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row
if lLastRow=1 then
wsSrc.UsedRange.Copy
else
lLastRow = lLastRow + 1
wsSrc.Range("A2",wsSrc.Cells(wsSrc.UsedRange.Rows.Count,wsSrc.UsedRange.Columns.Count)).Copy
end if
wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues
what I'm hoping for is the first time to copy everything including the header but each time after start on row 2 and copy everything else. Again I'm crossing my fingers I didn't make a silly mistake...
Jan 11 2021 11:45 PM
@mtarler it works perfekt. thanX! :)
how can i remove Duplicates after merging in code??
i do it after merging manually, "Data -> Remove Duplicates -> Select All -> OK"
Thanx. :)
Jan 11 2021 03:30 PM
Solution@LBoldrino I'm not going to create multiple workbooks to test and hope I get it right...
Try replacing the 3 lines inside your IF statement with this:
lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row
if lLastRow=1 then
wsSrc.UsedRange.Copy
else
lLastRow = lLastRow + 1
wsSrc.Range("A2",wsSrc.Cells(wsSrc.UsedRange.Rows.Count,wsSrc.UsedRange.Columns.Count)).Copy
end if
wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues
what I'm hoping for is the first time to copy everything including the header but each time after start on row 2 and copy everything else. Again I'm crossing my fingers I didn't make a silly mistake...